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' TCA.vbp 
Type=Exe 

Reference=nG{00020430-0000-0000-C000-000000000046}#2.0#0#.A.A.A.AWINNT\Sys^^^ 
Std01e2.Tlb#0LE Automation 

Reference=*\G{00020905-0000-0000-C000-000000000046}#8.0#409#.A.A..\Microsoft 
Office\Office\MSWORD8.0LB#Microsofl Word 8.0 Object Library 

Reference=*\G{953298D7-F0DE-llD2-AED3.000000000000}#13.0#0#AXProlog.exe#AXProl 
og 

Object={FE0065C0-lB7B-llCF-9D53-00AA003C9CB6}#l,l#0; COMCT232.0CX 

Object-{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.0CX 

Object={BDC217C8-ED16-llCD-956C-0000C04E4C0A}#l.l#0; TABCTL32.0CX 

Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.0CX 

Form=TCA.frm 

Module^Util; modUtil.bas 

Class=Model; Model. els 

Class=Constraint; Constraint. els 

Class=Variable; Variable.els 

Class=TCAApplication; Applieation.els 

Module^StartUp; Main.bas 

Form=Variable. frm 

Classic Variables; CVariables.els 

Class=CConstraints; CConstraints.els 

Form=Constraint . fhn 

Class=MSWord; Word.els 

Form==frmSplash. frm 

Class=VarInteger; Varlnteger.cls 

Class=VarReal; VarReal.els 

Class=VarFraetion; VarFraetion.cls 

Class=VarString; VarString.cls 

Form=fimIndexedString.frm 

Class=File; File. els 

Class^CClones; CClones.cls 

Class=IniFile; IniFile.els 

Class=Win32API; Win32APLels 

Class=CModels; CModels.cls 

Class=Cldne; Clone.cls 

Form=frmAttributes. fhn 

Class=Family; Family.els 

Class=DoeStatus; DoeStatus.els 

Class=Cheeksum; Cheeksum.cls 

Form=fimProgress.frm 

Class=Progress; Progress.els 

Form^frmDifficulty.fhn 

Class=DiffieultyEstimate; DifficultyEstimate.cls 
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Class=GREDifficultyEstimate; GREDifficultyEstimate.cls 
Class=SMCModel; PSModel.cls 
Class=QCModel; qcmodel.cls 
Class=DSModel; dsmodel.cls 
Class=VarUntyped; VarUntyped.cls 
Class=LockedItem; Lockedltem.cls 

Class=GMATDifficultyEstimate; GMATDifficultyEstimate.cls 

Form^firn About . frm 

Form=frmNew. frm 

Form=String.frm 

Class=SubString; SubString.cls 

Class=ConstraintSolver; ConstraintSolver.cls 

Class=StringSolver; StringSolver.cls 

Class^Value; Value.cls 

Class=PrintModel; PrintModel.cls 

Module=MTAPI; MTAPLbas 

Module=MTDeclarations; MTDeclarations.bas 

Module=MTUtil; MTUtil.bas 

Form=fnnProlog.frm 

ResFile32='Tca.res" 

IconForm="frmTCA" 

Startup="Sub Main" 

HelpFile="" 

Title='TCA" 

ExeName32="TCA.exe" 

Command32="" 

Name="Projectl" 

HelpContextID="0" 

CompatibleMode="0" 

MajorVer=0 

MinorVer=l 

RevisionVer=145 

AutoIncrementVer= 1 

ServerSupportFiles=0 

VersionCompanyName="ETS" 

GompilationType=0 

OptimizationType=2 

FavorPentiumPro(tm)=0 

CodeViewDebugInfo=0 

NoAliasing=0 

BoundsCheck=0 

OverflowCheck=0 

FlPointCheck=0 

FDIVCheck=0 

UnroundedFP=0 
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StartMode=0 
Unattended=0 
Retained=0 
ThTeadPerObject=0 
MaxNumberOfThreads= 1 



* AXProlog.vbp 
Type=01eExe 

Reference=nG{00020430-0000-0000-COOO-000000000046}#2.0#0#.A.A.A.AWINNT\Syst^^^ 
STD0LE2.TLB#0LE Automation 

Reference=*\G{3D5C6BF0-69A3-llD0-B393-00A0C9055D8E}#1.0#0#.A.A.ACommon 

Files\designer\MSDERUN.DLL#Microsoft Data Environment Instance 1.0 

Reference=*\G{00000200-0000-0010-8000-00AA006D2EA4}#2.0#0#.A.A.ACommon 

Files\system\ado\msado20.tlb#Microsoft ActiveX Data Objects 2.0 Library 

Class=Prolog; Prolog.cls 

Module=Modulel; Timer.bas 

Class=File; File.cls 

Startup="(None)" 

HelpFile="" 

ExeName32=" AXProlog.exe" 

Command32='"' 

Name="AXProlog" 

HelpContextID="0" 

CompatibleMode="r' 

CompatibleEXE32=" AXProlog.exe" 

MajorVer=l 

MinorVer=0 

RevisionVer=0 

AutoIncrementVer=0 

ServerSupportFiles=0 

VersionCompanyName="ETS" 

CompilationType=0 

OptimizationType=0 

FavorPentiumPro(tm)=0 

CodeViewDebugInfo=0 

NoAliasing=0 

BoundsCheck=0 

OverflowCheck=0 

FlPointCheck=0 

FDIVCheck=0 

UnroundedFP=0 

StartMode=l 

Unattended— 1 

Retained=0 

ThreadPerObj ect=- 1 

MaxNumberOfThreads=l 

DebugStartupOption=0 
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' Common.bas 

Attribute VB Name = "Common" 



01 
HI 
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' Main.bas 

Attribute VB_Name = "StartUp" 
Option Explicit 

Public Const READ_UNTIL_EOF = 0 

Public Const INI_DIRECTORY = "C:\TCS\TCA\OUT\TCAOUT.INI" 
Public Const IN_DIRECTORY = "CATCSMCAMNX" 
Public Const OUT_DIRECTORY = "C:\TCS\TCA\OUT\" 
Public Const LOCKED_ITEM_NAME = "TCATEMP.DOC" 
Public Const LVM_FIRST = &H1000 

Public Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54 
Public Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55 
Public Const LVS_EX_FULLROWSELECT = &H20 
Public Const HALT_FN = "C:\HALT.TCA" 

Public Const STRING_DELIMITER = 164 

Private Sub Main() 

Dim MyApp As New TCAApplication 

If App.PrevInstance Then 

Call MsgBox("Only one instance of TCA may be run at a time!", _ 
vbExclamation, "Error") 

Exit Sub 
End If 

' 10 seconds for component timeout 
App.OleRequestPendingTimeout = 10000 

MyApp. Run 

End Sub 



VBSCA -6- 



' modUtil.bas 

Attribute VB_Name = "Util" 
Option Explicit 

' Capitalizes the first letter of a string if it's a lower case letter 
Sub CapitalizeString(strInput As String) 

Dim strl, str2 As String 
Dim intStrLen As Integer 

intStrLen = Len(strlnput) 

If (intStrLen >0) Then 

strl = UCase(left(strInput, 1)) 
End If 

If(intStrLen> l)Then 

str2 = right(strlnput, intStrLen - 1) 
End If 

strlnput ^ strl & str2 
End Sub 

' Selects contents of text box for easy editing 
Sub txtSelectAll(txtTextBox As TextBox) 

' Automatically select all text 
txtTextBox.SelStart = 0 
txtTextBox.SelLength = Len(txtTextBox.Text) 

End Sub 

' Checks to see if a file exists 

Function FileExists(ByVal strFN As String) As Boolean 

Dim intFNum As Integer 

' Get the file number 
intFNum = FreeFile 

' Open the file and trap any errors 
On Error GoTo NotFound 
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Open strFN For Binary Access Read As #intFNum 
On Error GoTo 0 

Close #intFNum 



FileExists = True 
5 Exit Function 

NotFound: 

' Close the file 
Close #intFNum 
FileExists = False 
10 Exit Function 



End Function 

' extracts the path from a path/filename string 
Function ExtractPath(ByVal strFN As String) As String 



Dim varll As Variant 
1 Dim varI2 As Variant 



' find the last "\" in the string 
varll = 0 
Do 

^ varI2 = varll 

2M varll = InStr(varI2 + 1, strFN, "\") 

Lu Loop Until varll = 0 

Q ExtractPath = Mid(strFN, 1 , varI2) 

End Function 

' extracts the file name from a path/filename string 

25 Function ExtractFileName(ByVal strFN As String) As String 

Dim varll As Variant 
Dim varI2 As Variant 

* find the last "\" in the string 
varll = 0 
30 Do 
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varI2 = varll 

varll = InStr(varI2 + 1, strFN, "\") 
Loop Until varll = 0 

ExtractFileName = Mid(strFN, varI2 + 1, Len(strFN) - varI2) 
End Function 

' extracts the file name sans extension from a path/filename string 
Function ExtractFileNameNoExt(By Val strFN As String) As String 

strFN = ExtractFileName(strFN) 

Dim varll As Variant 
Dim varI2 As Variant 

• find the last in the string 
varll = 0 

Do 

varI2 = varll 

varll = InStr(varI2 + 1, strFN, ".") 
Loop Until varll = 0 

ExtractFileNameNoExt = Mid(strFN, 1, varI2 - 1) 
End Function 

* extracts the family name - everything up to $R 

Function ExtractFamilyName(ByVal strFN As String) As String 

StrFN = ExtractFileName(strFN) 

Dim varl As Variant 

• find "$R" in the string 
varl = InStr(l, StrFN, "$R") 

IfvarI>OThen 

ExtractFamilyName = Mid(strFN, 1, varl - 1) 
End If 

End Function 

' extracts the key, meaning $R and everthing up to the . 
Function ExtractFamilyKey(ByVal strFN As String) As String 
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strFN = ExtractFileName(strFN) 

Dim varl As Variant 
Dim varll As Variant 
Dim varI2 As Variant 

' find "$R" in the string 
varl = InStr(l, StrFN, "$R") 

' find the last in the string 

varll = 0 

Do 

varI2 = varll 

varll = InStr(varI2 + 1, strFN, ".") 
Loop Until varll = 0 

ExtractFamilyKey = Mid(strFN, varl, varI2 - varl) 
End Function 

' trim nulls off the end of a string 

Function TrimAtFirstNull(ByVal strS As String) As String 

Dim varl As Variant 

varl = InStr(l, strS, Chr(O)) 
TrimAtFirstNuU = lefl(strS, varl - 1) 

End Function 

' returns a string with all instances of strFrom replaced 
' with strTo in string strS 

Function ReplaceAll(ByVal strS As String, ByVal strFrom As String, 
ByVal strTo As String) As String 

Dim varl As Variant 
Dim intL As Integer 

Do 

varl = InStr(l, strS, strFrom) 
If varl > 0 Then * found strFrom 
intL = Len(strS) 

strS = left(strS, varl - 1) & strTo & _ 
right(strS, intL - Len(strFrom) - varl +1) 
End If 
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Loop Until varl = 0 
ReplaceAU = strS 
End Function 

' returns the name of indexed string variables 
5 Function GetIndexedName(ByVal strName As String, _ 
ByVal inti As Integer) As String 

GetlndexedName = strName & & Trim(Str(intI)) 

End Function 

10 * Prolog shuts down when this file is created 
Sub CreateKillFileQ 

Open HALT_FN For Output As #10 
O Print #10, "Halt!" 
m Close #10 

1^1 End Sub 

' Delete the kill file 
i? Sub DestroyKillFileO 

.i^ On Error Resume Next ' if it's not there, Kill will produce an error 

J Kill HALT_FN 

2I3 err. Clear 

Ci End Sub 
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' MTAPLBAS 

Attribute VB_Name = "MTAPI" 
'mtapi.bas 4.0 

' (c) Copyright 1992-1999 by Design Science, Inc. All rights reserved 
' with the exception that registered MathType owners may alter these 
' macros for use by themselves and other registered MathType owners 
' provided that: 

' 1) The alterations are summarized in a comment directly below this 
' copyright notice. The comment should start with the words 
' "Modified by" and include the name of the person altering the 
* macros, the date of alteration, and that person's email address 
' (if available). 

' 2) Persons altering the macros notify Design Science of the nature 
' of any changes they have made. 

' These provisions may help us help other customers, and will help us 
' continue to provide quality products for you in the future. 



' version # of this API 

Public Const MTAPI_VERSION = 4 

' maximum length of file paths, names, etc. 
Public Const MTAPI_MAX_PATH = 260 

* Picture specifier 

Public Type MTAPI_PICT 

mm As Long 

xExt As Long 

yExt As Long 

hMF As Long 
End Type 

PubHc Type RECT 

left As Long 

top As Long 

right As Long 

bottom As Long 
End Type 

' Picture dimensions 

Public Type MTAPI_DIMS 
baseline As Integer ' dist of baseline from bottom (points) 
bounds As RECT ' bounding rectangle (points) 
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End Type 

* return codes from MT DLL API 

' success, no error 
Public Const mtOK = 0 
5 ' equation OLE LO object on clipboard 
Public Const mtOLE_EQUATION = 1 

' Windows metafile equation graphic (not OLE object) on clipboard 
Public Const mtWMF_EQUATION = 2 

' Macintosh PICT equation graphic (not OLE object) on clipboard 
1 0 Public Const mtMAC_PICT_EQUATION = 4 
' equation OLE 2.0 object on clipboard 
Public Const mtOLE2_EQUATION = 8 

* error return codes 

* can't find MathType application 

1 |i Public Const mtMT_NOT_FOUND = - 1 

J3 ' can't run the MathType application 

01 Public Const mtMT_CANT_RUN = -2 

Ul ' the MathType application is the wrong version 

4J Public Const mtMT_BAD_VERSION - -3 
2^f ' the MathType application is already in use 

;| Public Const mtMT JNUSE = -4 

■^"^ ' the MathType application is not running (i.e. unexpectedly aborted) 
L Public Const mtMT NOT RUNNING = -5 
ifi ' time ran out waiting for the MathType apphcation to start up 
2|5 PubUc Const mtRlJN_TIMEOUT = -6 
1=5= ' not equation on clipboard 

□ Pubhc Const mtNOT_EQUATION = -7 

□ ' file does not exist or bad pathname 
Public Const mtFILE_NOT_FOUND = -8 

30 ' insufficient memory 

Public Const mtMEMORY = -9 
' bad file 

PubHc Const mtBAD FILE = -10 

' requested data does not exist 
35 Public Const mtDATA_NOT_FOUND = -1 1 

' too many server session open 

Public Const mtTOO_MANY_SESSIONS = -12 

' could not perform one or more subs 

Public Const mtSUBSTITUTION_ERROR = -13 
40 ' could not perform translation 

Public Const mtTRANSLATOR_ERROR = -14 
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' could not set preferences, or invalid preference string 
Public Const mtPREFERENCE_ERROR = -15 
' other error 

Public Const mtERROR = -9999 

5 ' options values for MTInitAPI 

Public Const mtinitLAlJNCH_AS_NEEDED = 0 
Public Const mtinitLAUNCH_NOW = 1 

' options values for MTGetTranslatorsInfo 
Public Const mttmCOUNT = 1 
1 0 Public Const mttmMAX_NAME = 2 
Public Const mttmMAX_DESC = 3 
Public Const mttmMAX_FILE = 4 
Public Const mttmOPTIONS = 5 

' options values for MTXFormAddVarSub 
1 5 Public Const mtxfinSUBST_ALL = 0 
n Public Const mtxfinSUBST_ONE = 1 C 

01 ' find/replace types for MTXFormAddVarSub substitutions 
Ul Public Const mtxfmVAR_SUB_B AD = - 1 
4r; Public Const mtxfmVAR_SUB_PLAlN_TEXT = 0 
2®^ Public Const mtxfmVAR_SUB_MTEF_TEXT = 1 

Public Const mtxfinVAR_SUB_MTEF_BINARY = 2 
Public Const mtxfinVAR SUB DELETE = 3 



' replace style for MTXFormAddVarSub substitutions when replaceType 
mtxfmVAR_SUB_PLAIN_TEXT 
2£ Public Const mtxfhiSTYLE_TEXT = 1 
p Public Const mtxfmSTYLE_FUNCTION = 2 
Q Public Const mtxfmSTYLE_VARIABLE = 3 
Public Const mtxfmSTYLE_LCGREEK = 4 
Public Const mtxfmSTYLE UCGREEK = 5 
30 Public Const mtxfmSTYLE_SYMBOL = 6 
Public Const mtxfmSTYLE VECTOR = 7 
Public Const mtxfmSTYLE_NUMBER = 8 

' options values for MTXFormSetPrefs 
Public Const mtxfmPREF_EXISTING = 1 
35 Public Const mtxfmPREF_MTDEFAULT = 2 
Public Const mtxfinPREF_USER = 3 
Public Const mtxfinPREF LAST = 3 

' options values for MTXFormSetTranslator 
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Public Const mtxfmTRANSL_INC_NONE = 0 
Public Const mtxfmTRANSL_INC_NAME = 1 
Public Const mtxfmTRANSL_INC_DATA = 2 
Public Const mtxfinTRANSL_INC_MTDEFAULT = 4 

' return values from MTXFormGetStatus 
Public Const mtxfinSTAT_PREF = -3 
Public Const mtxfinSTAT_TRANSL = -2 
Public Const mtxfinSTAT_ACTUAL_LEN = -1 

' data sources/destinations for MTXFormEqn 
Public Const mtxfinPREVIOUS = -1 
Public Const mtxfinCLIPBOARD = -2 
Public Const mtxfinLOCAL = -3 

' data formats for MTXFormEqn 
Public Const mtxfinMTEF = 4 
Public Const mtxfinHMTEF = 5 
Public Const mtxfmPICT = 6 
Public Const mtxfinTEXT = 7 
Public Const mtxfinHTEXT = 8 

' option values for MTSetMTPrefs 
Public Const mtprfMODE_NEXT_EQN = 1 
Public Const mtprfMODE_MTDEFAULT = 2 
Public Const mtprfMODE_INLINE = 4 

' MT API functions 

Public Declare Function MTAPIVersion Lib "mt4" (ByVal api As Integer) As Long 

Public Declare Function MTInitAPI Lib "mt4" (ByVal options As Integer, ByVal timeout As 

Integer) As Long 

Public Declare Function MTTermAPI Lib "mt4" () As Long 
Public Declare Function MTClearClipboard Lib "mt4" () As Long 
Public Declare Function MTEquationOnClipboard Lib "mt4" () As Long 
Public Declare Function MTXFormReset Lib "mt4" () As Long 
Public Declare Function MTXFormAddVarSub Lib "mt4" ( _ 
ByVal options As Integer, _ 

ByVal fmdXype As Integer, ByVal find As String, ByVal findLen As Long, _ 
ByVal replaceXype As Integer, ByVal replace As String, ByVal replaceLen As Long, _ 
ByVal replaceStyle As Integer _ 
) As Long 

Public Declare Function MTXFormSetTranslator Lib "mt4" (ByVal options As Integer, _ 

ByVal transName As String) As Long 
Public Declare Function MTXFormSetPrefs Lib "mt4" (ByVal prefType As Integer, ByVal 
prefStr As String) As Long 
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Public Declare Function MTSetMTPrefs Lib "mt4" (ByVal mode As Integer, ByVal prefs As 
String, _ 

ByVal timeout As Integer) As Long 
Public Declare Function MTXFormEqn Lib "mt4" ( _ 

ByVal src As Integer, ByVal srcFmt As Integer, ByVal srcData As String, ByVal srcDataLen 
As Long, _ 

ByVal dst As Integer, ByVal dstFmt As Integer, ByVal dstData As String, ByVal dstDataLen 
As Long, _ 

ByRef dims As MTAPI_DIMS) As Long 
Public Declare Function MTXFormGetStatus Lib "mt4" (ByVal index As Integer) As Long 
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' MTDeclaration.bas 

Attribute VB Name = "MTDeclarations" 



'Windows API declarations 



Public Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, 
ByVal IpHelpFile As String, By Val wCommand As Long, ByVal dwData As Long) As Long 
Public Declare Function LoadLibrary Lib "kemel32" Alias "LoadLibraryA" (ByVal 
IpLibFileName As String) As Long 

Public Declare Function FreeLibrary Lib "kemel32" (ByVal hLibModule As Long) As Long 
Public Declare Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hinstance As 
Long, ByVal wID As Long, ByVal IpBuffer As String, ByVal nBufferMax As Long) As Long 
Public Declare Function GetLocalelnfo Lib "kemel32" Alias "GetLocalelnfoA" (ByVal Locale 
As Long, ByVal LCType As Long, ByVal IpLCData As String, ByVal cchData As Long) As 
Long 

Public Declare Function GetEnvironmentVariable Lib "kemel32" Alias 

"GetEnvironmentVariableA" (ByVal IpName As String, ByVal IpBuffer As String, ByVal nSize 
As Long) As Long 

Public Declare Function SetEnvironmentVariable Lib "kemel32" Alias 
"SetEnvironmentVariableA" (ByVal IpName As String, ByVal IpValue As String) As Long 
Public Declare Function GetTickCount Lib "kemel32" () As Long 



' Constants for use in Windows API calls 



Used by GetLocalelnfo — 

' values for LCType (locale info requested) - used in MTLib.InitLocaleStrs 
Public Const Locale_SLanguage As Long = &H2 
Public Const Locale_SEngLanguage As Long = &H1001 



* Constants for use in Help calls 



Public Const hlpMSWDPreferences_Dialog =117 
Public Const hlpMSWDEquation_Number_Format_Dialog = 6300 
Public Const hlpMSWDFormat_Equations_Dialog = 6500 
Public Const hlpMSWDInsert_Equation_Section_Dialog =114 
Public Const hlpMSWDFomiat_Equation_Section_Dialog =116 
Public Const hlpMSWDSet_Equation_Preferences_Dialog = 37 
Public Const hlpMSWDConvert_Equations_Dialog = 44 
Public Const hlpMSWDInsert_Equation_Number_Dialog =118 
Public Const hlpMSWDInsert_Requation_Ref_Dialog =119 

Public Const hlpMSWDWT_SetEqnPrefs = 122 
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Public Const hlpMSWDWT_InlineEqn = 123 

Public Const hlpMSWDWT_CenteredEqn = 124 

Public Const hlpMSWDWT CenteredNumberedEqn = 125 

Public Const hlpMSWDWT_EqnNumber = 126 

Public Const hlpMSWDWT_EqnRef = 127 

Public Const hlpMSWDWT EqnSec = 128 

Public Const hlpMSWDWT_ModEqnSec = 129 

Public Const hlpMSWDWT_FomiatEqnNum = 130 

Public Const hlpMSWDWT_ConvertEqn =131 

Public Const hlpMSWDWT_FormatEqn = 132 

Public Const hlpMSWDWT_UpdateEqn = 133 



' Constants for use in the MathType Commands 



• Numbers we compare against with MTAPIvers 

Public Const mtversMajVerHi = 1279 'OxOAff 
Public Const mtversMajVerLo = 1024 '0x0400 
Public Const mtversMinVer = 1 024 '0x0400 

• Registry location codes 

Public Const mtreg_MT_LANG_LOC ATION As String = 

"HKEY_CURRENT_USER\Software\Design Science\DSMT4\Config" 'Registry entry for 
MathType's curent language 

Public Const mtreg_MT_LANG_KEY As String = "AppLang" 'registry key for MathType's 
curent language 

Public Const mtreg_MT_PROGDIR_LOCATION As String = 

"HKEY_LOCAL_MACHINE\SOFTWARE\Design Science\DSMT4\Directories" 'Registry 
entry for MathType's directory 

Public Const mtreg_MT_PROGDIR_KEY As String = "ProgDir" 'registry key for MathType's 
directory 

Public Const mtreg_MT_LANGUAGEDIR_LOCATION As String = 
"HKEY_LOCAL_MACHINE\SOFTWARE\Design Science\DSMT4\Directories" 'Registry 
entry for MathType's language support files directory 

Public Const mtreg_MT_LANGUAGEDIR_KEY As String = "LastLangDir" 'registry key for 

MathType's language support files directory 

Public Const mtreg_MT_HELPDIR_LOCATION As String = 

"HKEY_LOCAL_MACHINE\SOFTWARE\Design Science\DSMT4\Directories" 'Registry 
entry for MathType's help file directory 

Public Const mtreg_MT_HELPDIR_KEY As String = "LastHelpDir" 'registry key for 
MathType's help file directory 

Public Const mtreg_MT_HELPFILE_LOCATION As String = 

"HKEY_CURRENT_USER\Software\Design Science\DSMT4\Config" 'Registry entry for 
MathType's help file name 

Public Const mtreg_MT_HELPFILE_KEY As String = "HelpFile" 'registry key for 
MathType's help file name 
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Public Const mtreg_MT_SYSTEMDIR_LOCATION As String = 

"HKEY_LOCAL_MACHINE\SOFTWARE\Design Science\DSMT4\Directories" 'Registry 
entry for MathType's system directory 

Public Const mtreg_MT_SYSTEMDIR_KEY As String = "LastAppSystemDir" 'registry key 
5 for MathType's system directory 

Public Const mtreg_MT_PREFDIR_LOCATION As String = 

"HKEY_LOCAL_MACHINE\SOFTWARE\Design Science\DSMT4\Directories" 'Registry 
entry for MathType's preferences folder 

Public Const mtreg_MT_PREFDIR_KEY As String = "LastPrefsDir" 'registry key for 
10 MathType's system directory 

Public Const mtreg_MT_WORDCMDS_LOCATION As String = 
"HKEY_CURRENT_USER\SOFTWARE\Design Science\DSMT4\WordCommands" 
'Registry entry for MathType's Word Commands data 

Public Const mtreg_MT_WORD_CONVFROM As String = "ConvertFrom" 'ConvertFrom 
15 key 

Public Const mtreg_MT_WORD_CONVTO As String = "ConvertTo" 'ConvertTo key 
Public Const mtreg_MT_WORD_CONVMISC As String = "ConvertMisc" 'ConvertMisc key 
Public Const mtreg_MT_WORD_CONVTRANS As String = "ConvertTranslator" 
.1^ 'ConvertTranslator key 

201 Public Const mtreg_MT_WORD_DONTSHOW_EQNREFDLG As String = 

4" "NoInsertEqnRefDlg" 'Don't Show Insert Eqn Ref dialog key 

f Public Const mtreg_MT_WORD_DONTSHOW_SLOWEQNUPDATE As String = 

4= "NoSlowUpdateEqnDlg" 'Don't Show Insert Eqn Ref dialog key 

Public Const mtreg_MT_WORD_DONTSHOW_LANGDLLERROR As String - 
2kf "NoLanuageDLLError" 'Don't show Missing Lang DLL error key 

^ ' Strings used in MT text equations (TeX and MathML) 

n Public Const mttexteqn START As String - "% MathType!" 'The identifier at the beginning 
C!i of MathType translator text equations . 

Public Const mttexteqn_END As String = "% MathTypelEnd! " 'The identifier at the end of 
30 MathType translator text equations 

' Property names 

Public Const mtprop_USE_MATHTYPE_PREFS As String = "MTUseMTPrefs" 'The 
name of the Document Property that indicates to use MathType's prefs for new equations 
Public Const mtprop_PREFERENCES As String = "MTPreferences" 'Contains the 
35 doc's settings for new equations 

Public Const mtprop_PREFERENCES_FILE As String = "MTPreferenceSource" 'Contains 
the doc's settings for new equations 

Public Const mtprop_NUMBER_PREFS As String = "MTEquationNumber" 'Contains 
the current equation number format preferences 
40 Public Const mtprop_DEFER_FIELD_UPDATE As String = "MTDeferFieldUpdate" 
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'Controls field updating 

Public Const mtpropEQUATION_SECTION_CHECBCED As String = "MTEquationSection" 
'Indicates if eqn section number is 0 check has been made 

Public Const mtprop_EQNREFPANE As String = "MTEqnRefiPane" 'Pane number containing 
5 insertion point where ref. is to be placed 

' AutoText entry names 

Public Const mtautotext_MT3_EQN_NUMBER_FORMAT As String = 
"ZMTEqnNumFormatPrefs" 'The name of old Autotext entry that held MathType3's equation 
number format prototype 

1 0 • MathType OLE data 

Public Const mtole_PROGID As String = "Equation.DSMT4" 'OLE Prog ID used to identify 
MathType 4 

' Style names 

Public Const mtstyle_EQUATION_SECTION As String = "MTEquationSection" 'Style used for 
1 5 eqn. section names 
ej Public Const mtstyle_DISPLAY_EQUATION As String = "MTDisplayEquation" 'Style used 
b|] for display equations 

01 

U1 ' Misc. constants 

4= 'Constants used to specify 'curent selection' or 'whole document' 

Public Const mt_RANGE_DOCUMENT = 0 
4= Public Const mt RANGE SELECTION = 1 



fa.!: 



'Constants used by MTMsgBox 
Public Const mt_MBYESNO = 1 
g Public Const mt_MBYESNOCANCEL = 2 
2tf Public Const mt_MBYES = 1 
O Public Const mt_MBNO = 2 
Ci Public Const mt_MBCANCEL = 3 

'Flag bit for MTLib.SaveWordStateQ 
Public Const mt_SWS_TRACKCHANGES = 1 
30 Public Const mt_SWS_SMART_CUTPASTE = 2 

Public Const mt SWS TYPING REPLACE SELECTION = 4 
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' MTUtil.bas 

Attribute VB_Name = "MTUtil" 
'MTUtil: 4.0 



(c) Copyright 1992-1999 by Design Science, Inc. All rights reserved 
with the exception that registered MathType owners may alter these 
macros for use by themselves and other registered MathType owners 
provided that: 

1) The alterations are summarized in a comment directly below this 
copyright notice. The comment should start with the words 
"Modified by" and include the name of the person altering the 
macros, the date of alteration, and that person's email address 

(if available). 

2) Persons altering the macros notify Design Science of the nature 
of any changes they have made. 

These provisions may help us help other customers, and will help us 
continue to provide quality products for you in the future. 



This macro contains subroutines used by other Design Science macros 



Option Explicit 
'Public Sub Main() 

' MsgBox MTUtil.GetUserStringC'! 1600This contains a library of functions shared by 
MathType's macros."), _ 

vbOKOnly, MTUtil.GetUserStringC ! 1 60 IMTUtil Macro") 
'End Sub 



CheckMTDLLVersionO 
'Checks the MT DLL version. If it's a bad version, we display an 
'error and return 0. If we can still run, returns nonzero 



Public Function CheckMTDLLVersionO 
Dim errorflag 
Dim dllver 
Dim msg$ 
Dim myResult 

errorflag = 0 

CheckMTDLLVersion = 1 'assume success to start 
'init the API 



VBSCA -21- 



If MTInitAPI(mtinitLAUNCH_AS_NEEDED, 30) o 0 Then 

msg$ = MTUtil.GetUserString("!1606The MathType commands could not communicate 
with MathType. There was a problem starting the API. Please be sure that MathType is properly 
installed.") 

CheckMTDLLVersion = 0 
errorflag = 1 
Else 

'get the API Version 

dllver = MTAPIVersion(MTAPI_VERSION) 
'check the version against our constants 

If (dllver > mtversMaj VerHi) Or (dllver < mtversMajVerLo) Then 

msg$ = MTUtil.GetUserStringC ! 1607The version of this macro doesn't match the 
version of MathType's DLL. Reinstall MathType to fix this condition.") 
CheckMTDLLVersion = 0 
errorflag = 1 
Elself (dllver < mtversMinVer) Then 

msg$ = MTUtil.GetUserStringC ! 1 608 A more recent version of MathType's DLL is 
required to use this macro. Reinstall MathType to fix this condition.") 
CheckMTDLLVersion = 0 
errorflag = 1 
End If 
End If 

If (errorflag =1) Then 'report error condition 

MsgBox msg$, vbCritical, MTUtil.GetUserStringC'! 1609MathType Commands for 
Microsoft Word Error") 

End If 
End Function 



GetUserStringS 



Public Function GetUserString$(EnglishString$) 

'simply retum the English version (strip "Inrmn" from start) 
GetUserStringS = right(EnglishString$, Len(EnglishString$) - 5) 

End Function 



GetMathTypeDir$ 
Gets the location of MathType from the registry 



Public Function GetMathTypeDirSQ 
Dim path$ 

VBSCA -22- 



'get the location of Mathtype from the registry 

paths = System.PrivateProfileStringC", mtreg_MT_PROGDIR_LOCATION, 
mtreg_MT_PROGDIR_KEY) 

'return the results 
GetMathTypeDirS = pathS 
End Function 



WritePermSetting 



10 



Writes key/value pair to permanent location, ie Windows registry. 

Used when data needs to be saved whose scope is larger than a document. 

Public Sub WritePermSetting(key$, data$) 

System.PrivateProfileStringC", mtreg_MT_WORDCMDS_LOCATION, key$) = data$ 
End Sub 



15=1 



2|f 



30 



ReadPermSettingS 



Reads key's value from the permanent location, ie Windows registry. 
Used when data needs to be saved whose scope is larger than a document. 
Public Function ReadPermSetting$(key$) 

ReadPermSettingS = System.PrivateProfileStringC"", mtreg_MT_WORDCMDS_LOCATION, 
key$) 

End Function 



SetNextTXFormPrefs 
Sets prefs that MathType will use for the next transformed equation. 
Retums MTXFormSetPrefs result code. 



Function SetNextTXFormPrefs(prefStr$) 
Dim Stat 



'set preferences for next transformed equation 

Stat = MTXFormSetPrefs(mtxfmPREF_USER, prefStrS) 

IfstatoOThen 

MsgBox MTUtil.GetUserString("! UOOThere was a problem sending your equation 
35 preferences for " _ 

+ "this document to MathType. This equation will use MathType's " _ 
+ "*New Equation' preferences."), vbExclamation, _ 
MTUtil.GetUserString("!1101MathType Preferences Problem") 
End If 
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SetNextTXFormPrefs = stat 
End Function 



' SetPrefsForNextEqn 

'Sets prefs that MathType will use for the next new equation. 
'Returns MTSetMTPrefs result code. 



Public Function SetPrefsForNextEqn(prefStr$, inline As Boolean) 
Dim stat 

Dim options As Integer 

options = mtprfMODE_NEXT_EQN 

If inline Then options = options + mtprfMODE_INLINE 

'set preferences for next transformed equation 

stat = MTSetMTPrefs(options, prefStrS, - 1 ) 

If stat oO Then 

MsgBox MTUtil.GetUserString('M 1 lOOThere was a problem sending your equation 
preferences for " _ 

+ "this document to MathType. This equation will use MathType's " _ 
+ '"New Equation' preferences."), vbExclamation, _ 
MTUtil. GetUserString(" 11101 MathType Preferences Problem'^ 
End If 

SetPrefsForNextEqn = stat 
End Function 



' IsEquationProgID 

'Returns 1 if the progID is a MathType/EE OLEl proglD. 
'Returns 2 if the progID is a MathType/EE 0LE2 proglD. 
'Returns 0 if not a recognized progID. 



Public Function IsEquationProgID(progID$) As Long 
Dim uProglDS 
uProglDS - UCase(progID$) 

If uProgID$ = "EQUATION" Then 

IsEquationProgID = 1 
Elself InStr(l, uProglDS, "EQUATION.", vbBinaryCompare) = 1 Then 

IsEquationProgID = 2 
Else 

IsEquationProgID = 0 
End If 
End Function 
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' TransformGraphicEquation 

'Attempts to transform the graphic on the clipboard into an equation. 

'Resulting format depends on how MathType has been configured by a 

'previous call to MTXFormSetTranslator. 

'The transformed equation is left on the clipboard. 

'If OK, returns mtOK 

'If not an equation, or an error occurred, returns mtNOT_EQUATION 



Public Function TransformGraphicEquationQ As Long 
TransformGraphicEquation = mtNOT_EQUATION 

'Use API call to check clipboard contents first 

If MTEquationOnClipboardO = mtNOT_EQUATION Then 

Exit Function 
End If 

TransformGraphicEquation = TransformEquation() 
End Function 



' TransformEquation 

'Attempts to transform the item on the clipboard into an equation. 

'Resulting format depends on how MathType has been configured by a 

'previous call to MTXFormSetTranslator. 

'The transformed equation is left on the clipboard. 

'If OK, returns mtOK 

'If not an equation, or an error occurred, returns mtNOT_EQUATION 



PubUc Function TransformEquationQ As Long 
Dim Stat As Long 
Dim dummyStrlS, dunimyStr2$ 
Dim dummyDims As MTAPI_DIMS 

On Error GoTo err 

Stat = mtNOT_EQUATION 

'as long as everything's OK, update the equation 
'set aside some buffers 
dummyStrl$ = Space(l) 
dummyStr2$ = Space(l) 
With dummyDims 

.baseline = 0 

.bounds.bottom ~ 0 

.bounds. left = 0 

.bounds. right = 0 
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.bounds.top = 0 
End With 

*do the update 

Stat = MTXFormEqn(mtxfmCLIPBOARD, mtxfinTEXT, dummyStrlS, 1, _ 
mtxfinCLIPBOARD, mtxfmTEXT, dummyStr2$, 1, dummyDims) 

If Stat <0 Then 

Stat = mtNOT_EQUATION 

End If 

GoTo Bye 

err: 

If err.Number = 5690 Or err.Number = 4198 Then 

'the user has revisions on, and this is an old revision that has been deleted 

Stat = -2 

Resume Bye 
Else 

err.Raise err.Number 
Stop 
End If 
Bye: 

TransformEquation = stat 
End Function 



* DeleteDocProperty 

t.-.^-.^,— _ _ ______ __ ■ —TZ- 

*deletes document property, OK to call if it doesn't exist " 
Public Function DeleteDocProperty(doc As Document, prop$) 
On Error GoTo Error 

doc.CustomDocumentProperties(prop$).Delete 
Error: 

End Function 



DocPropertyExists 



'returns True if the active document contains the custom doc property 
Public Function DocPropertyExists(propName$) As Boolean 
Dim name$ 

DocPropertyExists = False 
On Error GoTo Error 

name$ = ActiveDocument.CustonvDocumentProperties(propName$).name 



VBSCA -26- 



DocPropertyExists = True 
Error: 

End Function 



Delay 

'Pauses execution for timeout (in milliSecs) 



Public Sub Delay(timeout As Long) 
Dim start As Long 
start = GetTickCountQ 

Do While (GetTickCountQ < (start + timeout)) 

DoEvents * Yield to other processes. 
Loop 
End Sub 
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' Timer.bas 

Attribute VB_Name = "Module 1" 
Option Explicit 

Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _ 

ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal IpTimerProc As Long) 
As Long 

Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _ 
ByVal nIDEvent As Long) As Long 

Public gProlog As Prolog 
Public gTimerlD As Long 



* called by SolveConstraintsRandomly in Prolog. els 
Public Sub SolveAsyncQ 

' calls TimerCallback when timer runs out (it*s set for 0, so it 

* runs out immediately. TimerCallback, and anything called by 

* TimerCallback, run async. 

gTimerlD = SetTimer(0, 0, 1000, AddressOf TimerCallback) 
End Sub 

Public Sub TimerCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As 
Long, ByVal dwTime As Long) 

KillTimer 0, gTimerlD 

gProlog.SolveConstraints Async ' in Prolog.cls 



End Sub 
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' Contraint.fim 
VERSION 5.00 

Object = "{BDC217C8-ED16-llCD-956C-0000CO4E4COA}#l.l#O"; "TABCTL32.0CX" 
Begin VB.Form frmConstraints 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "Create or Change Constraints" 
ClientHeight = 6405 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 6285 
LinkTopic = "Forml" 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 6405 
ScaleWidth = 6285 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin TabDlg.SSTab sstConstraintTool 

Height = 3375 

Left = 240 

Tablndex = 5 

Top = 1080 

Width = 4455 

_ExtentX = 7858 

_ExtentY = 5953 

_Version = 393216 

TabHeight = 520 

BeginProperty Font {0BE35203-8F91-1 1CE-9DE3-00AA004BB85 1 } 

Name = "MS Sans Serif 

Size = 8.25 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 

TabCaption(O) = "Operators" 
TabPicture(O) = "Constraint.frx":0000 
Tab(0).ControlEnabled= -1 'True 
Tab(0).Control(0)= "cmdElself , 
Tab(0).Control(0).Enabled= 0 'False 
Tab(0).Control(l)= "cmdElse" 
Tab(0).Control(l).Enabled= 0 'False 
Tab(0).Control(2)= "cmdThen" 
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Tab(0).Control(2).Enabled= 0 'False 
Tab(0).Control(3)= "cmdlf 
Tab(0).Control(3).Enabled= 0 'False 
Tab(0).Control(4)= "cmdLessThanOrEqualTo" 
Tab(0).Control(4).Enabled= 0 'False 
Tab(0).Control(5)= "cmdGreaterThanEqualTo" 
Tab(0).Control(5).Enabled= 0 'False 
Tab(0).Control(6)= "cmdLessThan" 
Tab(0).Control(6).Enabled- 0 'False 
Tab(0).Control(7)= "cmdGreaterThan" 
Tab(0).Control(7).Enabled= 0 'False 
Tab(0).Control(8)= "cmdNotEqual" 
Tab(0).Control(8).Enabled= 0 'False 
Tab(0).Control(9)= "cmdAbs" 
Tab(0).Control(9).Enabled= 0 'False 
Tab(0).Control(l 0)= "cmdFactorial" 
Tab(0).Control(10).Enabled= 0 'False 
Tab(0).Control(l 1)= "cmdExponent" 
Tab(0).Control(ll).Enabled= 0 'False 
Tab(0).Control(l 2)= "cmdQuotient" 
Tab(0).Control(12).Enabled= 0 'False 
Tab(0).Control(13)= "cmdList" 
Tab(0).Control(13).Enabled= 0 'False 
Tab(0).Control( 1 4)= "cmdModulus" 
Tab(0).Control(14).Enabled= 0 'False 
Tab(0).Control(15)= "cmdEqual" 
Tab(0).Control(15).Enabled= 0 'False 
Tab(0).Control(16)= "cmdDivide" 
Tab(0).Control(16).Enabled= 0 'False 
Tab(0).Control(17)= "cmdMultiply" 
Tab(0).Control(17).Enabled= 0 'False 
Tab(0).Control(18)= "cmdMinus" 
Tab(0).Control(18).Enabled= 0 'False 
Tab(0).Control(19)= "cmdPlus" 
Tab(0).Control(19).Enabled= 0 'False 
Tab(0).Control(20)= "cmdParens" 
Tab(0).Control(20).Enabled= 0 'False 
Tab(0).ControlCount= 21 
TabCaption(l) = "Variables" 
TabPicture(l) = "Constraint.frx":001C 
Tab(l).ControlEnabled= 0 'False 
Tab(l).Control(0)= "cboVariableNames" 
Tab(l).Control(0).Enabled= 0 'False 
Tab(l).Control(l)= "cmdInsertVN" 
Tab(l).Control(l).Enabled= 0 'False 
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Tab(l).ControlCount= 2 
TabCaption(2) = "Functions" 
TabPicture(2) = "Constraint.frx":0038 
Tab(2).ControlEnabled= 0 'False 
5 Tab(2).Control(0)= "cboFunction" 

Tab(2).Control(0).Enabled= 0 'False 
Tab(2).Control(l)= "cmdInsertFunction" 
Tab(2).Control(l).Enabled= 0 'False 
Tab(2).Control(2)= "txtFunctionDescription" 
10 Tab(2).Control(2).Enabled= 0 'False 

Tab(2).ControlCount= 3 
Begin VB.CommandButton cmdParens 
Caption = "()" 
BeginProperty Font 
15 Name = "MS Sans Serif ' 

Size = 9.75 
Charset = 0 
Weight = 400 
Underline = 0 'False 
2f{ Italic = 0 'False 

m Strikethrough = 0 'False 



2JIS 



2f End 
3^f Begin VB.ComboBox cboFunction 

5 Height =315 

ft ItemData = "Constraint.frx":0054 

Left = -74400 

List = "Constraint.frx":007C 
35 Style = 2 'Dropdown List 

Tablndex =31 

ToolTipText = "Select a Prolog function from the list." 

Top = 840 

Width = 2175 
40 End 

Begin VB.CommandButton cmdInsertFunction 

Caption = "Insert" 

Height = 315 

Left = -72120 

45 Tablndex = 30 



EndProperty 




Height 


375 


Left 


2280 


Tablndex 


= 32 


ToolTipText 


= "List' 


Top = 


1320 


Width 


495 
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ToolTipText = "Click here to insert this function into the constraint above at the current 
cursor position." 

Top = 840 

Width = 855 
End 

Begin VB.TextBox txtFunctionDescription 
Height = 1455 
Left = -74400 
Locked = -1 'True 
MultiLine = -1 'True 
ScrollBars = 2 'Vertical 
Tablndex = 29 

ToolTipText = "The description of the function appears in this window." 
Top =1320 
Width = 3135 
End 

Begin VB.ComboBox cboVariableNames 
Height = 315 
ItemData = "Constraint.frx":OOEF 
Left = -74400 
List = "Constraint.frx":0117 
Style = 2 'Dropdown List 
Tablndex = 28 

ToolTipText = "Select a Prolog fiinction fi-om the list." 
Top = 1320 

Width = 2175 
End 

Begin VB.CommandButton cmdInsertVN 
Caption = "Insert" 
Height =315 
Left = -72120 
Tablndex = 27 

ToolTipText = "Click here to insert this variable name into the constraint above at the 
current cursor position." 
Top = 1320 

Width = 855 
End ' 

Begin VB.CommandButton cmdPlus 
Caption = "+" 
BeginProperty Font 

Name = "MS Sans Serif ' 

Size = 9.75 

Charset = 0 

Weight = 400 

Underline = 0 'False 
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Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height =375 
5 Left = 480 

Tablndex = 25 
ToolTipText = "Plus" 
Top = 840 

Width = 495 
10 End 

Begin VB.CommandButton cmdMinus 
Caption = "-" 
BeginProperty Font 
Name = "MS Sans Serif ' 

15 Size = 9.75 

Charset = 0 
Weight = 400 
Underline = 0 'False 
Italic = 0 'False 
2j( Strikethrough = 0 'False 

EndProperty 
Height = 375 
^ Left = 1080 

h Tablndex = 24 

2S~ ToolTipText = "Minus" 

m Top = 840 

Width = 495 
End 

'% Begin VB.CommandButton cmdMultiply 

M Caption = "*" 

j==, BeginProperty Font 

g Name = "MS Sans Serif 

Size = 9.75 

Charset = 0 
35 Weight = 400 

Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
40 Height =375 

Left = 1680 
Tablndex = 23 
ToolTipText = "Multiply" 
Top = 840 

45 Width = 495 
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End 

Begin VB.CommandButton cmdDivide 
Caption . = 7" 
BeginProperty Font 
5 Name = "MS Sans Serif ' 

Size = 9.75 

Charset = 0 
Weight = 400 
Underline = 0 'False 
10 Italic - 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 2280 
15 Tablndex = 22 

ToolTipText = "Divide" 
Top = 840 

Width = 495 
End 

Begin VB.CommandButton cmdEqual 
m ' Caption = "=" 

yi BeginProperty Font 

i Name = "MS Sans Serif ' 

^ Size = 9.75 

2l= Charset = 0 

^ Weight = 400 

Underline = 0 'False 
Itahc = 0 'False 
Strikethrough = 0 'False 
3W EndProperty 

Height = 375 
g Left = 480 

Tablndex = 21 
ToolTipText = "Equals" 
35 Top = 1800 

Width = 495 
End 

Begin VB.CommandButton cmdModulus 
Caption = "%" 
40 BeginProperty Font 

Name = "MS Sans Serif 

Size = 9.75 

Charset = 0 
Weight = 400 
45 Underline = 0 'False 
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Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height = 375 
5 Left = 2880 

Tablndex = 20 
ToolTipText = "Modulo" 
Top = 840 

Width = 495 
10 End 

Begin VB.CommandButton cmdList 
Caption = "([1,2])" 
BeginProperty Font 
Name = "MS Sans Serif ' 

15 Size = 9.75 

Charset = 0 
Weight = 400 
Underline = 0 'False 
Italic = 0 'False 
2|{ Strikethrough = 0 'False 

EndProperty 
yi Height =375 

Left = 2880 

^ Tablndex = 19 

2l» ToolTipText = "List" 

J3 Top = 1320 

I., Width = 1095 

End 

't,;. Begin VB.CommandButton cmdQuotient 

3g Caption = "\" 

f"i BeginProperty Font 

g Name = "MS Sans Serif ' 

Size = 9.75 
Charset - 0 
35 Weight = 400 

Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
40 Height = 375 

Left = 480 
Tablndex = 18 
ToolTipText = "Quotient" 
Top = 1320 

45 Width = 495 
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End 

Begin VB.CommandButton cmdExponent 
Caption = 
BeginProperty Font 
5 Name = "MS Sans Serif ' 

Size = 9.75 
Charset = 0 
Weight = 400 
Underline = 0 'False 
10 Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 3480 
15 Tablndex = 17 

ToolTipText = "Exponent" 
Top = 840 

Width = 495 
n End 
2Si Begin VB.CommandButton cmdFactorial 

5 Caption = "!" 

Ul BeginProperty Font 

$ Name = "MS Sans Serif ' 

a3 Size = 9.75 

2^ Charset = 0 

a3 Weight = 400 

Underline = 0 'False 
Italic = 0 'False 
'pt Strikethrough = 0 'False 

3|i EndProperty 
n Height = 375 

p Left = 1080 

Tablndex = 16 
ToolTipText = "Factorial" 
35 Top = 1320 

Width = 495 
End 

Begin VB.CommandButton cmdAbs 
Caption = "H" 
40 BeginProperty Font 

Name = "MS Sans Serif 
Size = 9.75 
Charset = 0 
Weight = 400 
45 Underline = 0 'False 
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Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left =1680 
Tablndex = 15 
ToolTipText = "Absolute value" 
Top = 1320 

Width = 495 
End 

Begin VB.CommandButton cmdNotEqual 
Caption = "=/=" 
BeginProperty Font 

Name = "MS Sans Serif 

Size = 9.75 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 1080 
Tablndex = 14 
ToolTipText = "Does not equal" 
Top = 1800 

Width = 495 
End 

Begin VB.CommandButton cmdGreaterThan 
Caption = ">" 
BeginProperty Font 

Name = "MS Sans Serif ' 

Size = 9.75 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left =1680 
Tablndex = 13 
ToolTipText = "Greater than" 
Top = 1800 

Width = 495 
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End 

Begin VB.CommandButton cmdLessThan 
Caption = "<" 
BeginProperty Font 
5 Name = "MS Sans Serif ' 

Size = 9.75 

Charset = 0 
Weight = 400 
Underline = 0 'False 
10 Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 2280 

15 Tablndex = 12 

ToolTipText = "Less than" 
Top =1800 
Width = 495 
s=>i End 

2O3 Begin VB.CommandButton cmdGreaterThanEqualTo 

01 Caption = ">=" 

yi BeginProperty Font 

Name = "MS Sans Serif ' 
^3 Size = 9.75 

2^ Charset = 0 

^ Weight = 400 

l,^ Underline = 0 'False 

^ Italic = 0 'False 

Strikethrough = 0 'False 



3.0=, EndProperty 



Height = 375 
P Left = 2880 

Tablndex =11 

ToolTipText = "Greater than or equal to" 
35 Top = 1800 

Width = 495 
End 

Begin VB.CommandButton cmdLessThanOrEqualTo 
Caption = "<=" 
40 BeginProperty Font 

Name = "MS Sans Serif ' 
Size = 9.75 

Charset = 0 
Weight = 400 
45 Underline = 0 'False 

VBSCA -38- 



# 



Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height =375 
5 Left = 3480 

Tablndex = 10 

ToolTipText = "Less than or equal to" 
Top = 1800 

Width = 495 
10 End 

Begin VB.CommandButton cmdif 
Caption = "if 
BeginProperty Font 
Name = "MS Sans Serif ' 

15 Size = 9.75 

Charset- = 0 
Weight = 400 
Underline = 0 'False 
a Italic = 0 'False 

Strikethrough = 0 'False 
01 EndProperty 
Ul Height = 375 

4= Left = 480 

Tablndex = 9 
2£ ToolTipText = "If 

^•^ Top = 2280 

L Width = 735 

^ End 

f i Begin VB.CommandButton cmdThen 

3QI Caption = "then" 

ri BeginProperty Font 

O Name = "MS Sans Serif 

Size = 9.75 
Charset = 0 
35 Weight = 400 

Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
40 Height = 375 

Left = 1320 
Tablndex = 8 
ToolTipText = "then" 
Top = 2280 

45 Width = 735 
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I 



End 

Begin VB.CommandButton cmdElse 
Caption = "else" 
BeginProperty Font 
5 Name = "MS Sans Serif 

Size = 9.75 

Charset = 0 
Weight = 400 
Underline = 0 'False 
10 Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 375 
Left = 2160 
15 Tablndex = 7 

ToolTipText = "else" 
Top = 2280 

Width = 735 
CI End 
2S3 Begin VB.CommandButton cmdElself 

fil Caption - "elseif 

y1 BeginProperty Font 

4= Name = "MS Sans Serif ' 

Size = 9.75 

2X Charset = 0 

Weight = 400 
Underline = 0 'False 
% Italic = 0 'False 

p5 Strikethrough = 0 'False 

3^ EndProperty 
0 Height = 375 

P Left = 3000 

Tablndex = 6 
ToolTipText = "elseif 
35 Top = 2280 

Width = 975 
End 
End 

Begin VB.TextBox txtConstraint 
40 Height = 315 

Left = 240 
Tablndex = 3 

ToolTipText = "Enter the constraint here." 
Top - 480 

45 Width = 4455 
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End 

Begin VB.TextBox txtComment 
Height = 1335 
Left = 240 
MultiLine - -1 'True 
Tablndex = 0 
Top = 4800 

Width = 4455 
End 

Begin VB.CommandButton cmdConOK 
Caption = "OK" 
Default = -1 'True 
Height = 495 
Left = 4920 
15 Tablndex = 1 

ToolTipText = "Click here to save this constraint." 
Top = 120 

Width = 1215 
Cj End 

2QE3 Begin VB.CommandButton cmdConCancel 
S"^ Caption = "Cancel" 

vl Height - 495 

^ Left = 4920 

*f Tablndex = 2 

2S ToolTipText = "Click here to return without creating or-modifying this constraint." 

Top =720 
p Width = 1215 

End 

n Begin VB. Label IblComment 
Caption = "Comment" 
Height = 255 
Left = 240 
Tablndex = 26 
Top = 4560 

Width = 1215 
End 

Begin VB. Label IblConstraints 
Caption = "Constraint" 
Height = 255 
40 Left = 240 

Tablndex = 4 

ToolTipText = "Click on the down arrow for fimction prototypes" 
Top = 240 

Width =1695 
45 End 
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End 

Attribute VB_Name = "frmConstraints" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private mbytAddEditFlag As Byte 
Private mlstListBox As ListBox 
Private mudtCon As Constraint 
Private mudtModel As Model 
Private mudtConType As ConstraintType 

Private Enum ResourceStrings 

rcStartFunctions =101 

rcEndFunctions =125 

rcStartExplanations = 201 
End Enum 

Private mblnChangeFocus As Boolean 

Public Property Let AddEditFlag(ByVal bytNewValue As Byte) 

mbytAddEditFlag = bytNewValue 
End Property 

Public Property Let ListBox(ByVal IstNewValue As ListBox) 

Set mlstListBox = IstNewValue 
End Property 

Public Property Let Constraint(ByVal udtNew Value As Constraint) 

Set mudtCon = udtNewValue 
End Property 

Public Property Let ConstraintType(ByVal udtNewValue As ConstraintType) 
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mudtConType = udtNewValue 
End Property 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
5 End Property 

Private Sub cboFunction_Click() 

Dim inti As Integer 

For intI = 0 To cboFunction.ListCount - 1 
10 If cboFunction = cboFunctionXist(intl) Then 

txtFunctionDescription = LoadResString(intI + rcStartExplanations) 
Exit For 
End If 
Next intI 

I n If mblnChangeFocus Then 

j» txtConstraint.SetFocus 
S End If 

m End Sub 

CJ Private Sub cboVariableNames_Click() 

-==! If mblnChangeFocus Then 

txtConstraint.SetFocus 
Ef End If 

End Sub 

Private Sub cmdElse_CHck() 
Call InsertTextC'else", 0) 
30 End Sub 

Private Sub cmdElseIf_Click() 
Call InsertTextC'elseif 0) 



VBSCA -43- 



End Sub 

Private Sub cmdGreaterThan_Click;() 

Call InsertText(">", 0) 
End Sub 

Private Sub cmdGreaterThanEqualTo_Click() 

Call InsertText(">=", 0) 
End Sub 

Private Sub cmdIf_Click() 
Call InsertTextC'if 0) 
End Sub 

Private Sub cmdParens_Click() 

Call InsertTextC'O", 1) 
End Sub 

Private Sub cmdThen_Click() 

Call InsertTextC'then", 0) 
End Sub 

Private Sub cmdInsertFunction_Click() 

If cboFunction = "brandomQ" Or cboFunction = "randomQ" Then 

Call InsertText(cboFunction, 0) 
Else 

Call InsertText(cboFunction, 1) 
End If 

End Sub 

Private Sub cmdInsertVN_Click() 
Call InsertText(cboVariableNames, 0) 
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End Sub 

Private Sub cmdLessThan_Click() 
Call InsertText("<") 

5 

End Sub 

Private Sub crndLessThanOrEqualTo ClickQ 
Call InsertText("<=", 0) 
10 End Sub 

Private Sub cmdNotEqual_Click() 
Call InsertText("=/=", 0) 
S End Sub 

l|i Private Sub cmdPlus_Click() 
2 Call InsertText("+") 

-Jj End Sub 

y Private Sub cmdMinus_Click() 
P Call InsertTextC'-") 
End Sub 

Private Sub cmdMultiply ClickQ 

Call InsertTextC'*") 
End Sub 

Private Sub cmdDivide ClickQ 
25 Call InsertTextC'/") 

End Sub 
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Private Sub cmdModulus ClickO 

Call InsertText("%") 
End Sub 

Private Sub cmdEquar Click() 
5 Call InsertText("=") 

End Sub 

Private Sub cmdList_Click() 

Call InsertText("([])", 2) 
End Sub 

IQ.^ Private Sub crndQuotient ClickQ 
S Call InsertText("\") 

y - 

j= End Sub 

Iz Private Sub cmdExponent_Click() 
r Call InsertTextC'^") 

1^' End Sub 
^ Private Sub cmdFactorial_Click() 
CallInsertText('M") 
End Sub 

Private Sub cmdAbs_Click() 
20 Call InsertText("|r, 1) 

End Sub 

Private Sub InsertText(ByVal strlnsertedText As String, 
Optional ByVal intOffset As Integer = -1) 
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Dim strFront As String 
Dim strBack As String 

If intOffset = -1 Then intOffset = Len(strlnsertedText) - 1 

StrFront = left(txtConstraint, txtConstraint.SelStart) 
StrBack = right(txtConstraint, Len(txtConstraint) - _ 
txtConstraint.SelStart - txtConstraint.SelLength) 

txtConstraint = strFront & strlnsertedText & strBack 
txtConstraint.SetFocus 

' move the cursor 

txtConstraint.SelStart = Len(strFront) + Len(strlnsertedText) - 
End Sub 

Private Sub Command3_Click() 
End Sub 

Private Sub Form_Load() 

' disable OK button if changes aren't allowed 
If mudtModel.IsFrozen Then 

cmdConOK.Enabled = False 
Else 

cmdConOK.Enabled = True 
End If 

Dim udtV As Variable 

* load variable names into combo box 

cboVariableNames. Clear 

For Each udtV In mudtModel. Variables 

Call cboVariableNames. Addltem(udtV.name) 
Next udtV 

If mbytAddEditFlag = aeEdit Then 

txtConstraint = mudtCon. Constraints tring 

txtComment = mudtCon. Comment 
End If 

'load functions into combo box 
Dim inti As Integer 
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For inti = rcStartFunctions To rcEndFunctions 

cboFunction.List(intI - rcStartFunctions) = LoadResString(intl) 
Next intI 

mblnChangeFocus = False 

If cboVariableNames.ListCount > 0 Then 

cboVariableNames.Listlndex = 0 
End If 

cboFunction.Listlndex = 0 
mblnChangeFocus = True 

End Sub 

Private Sub cmdConOK_Click() 

If Len(txtConstraint) = 0 Then 

Call MsgBox("Null constraints are not permitted", vbExclamation, "Error") 

Exit Sub 
End If 

If mbytAddEditFlag = aeEdit Then ' we're editing an old one 

• update the constraint with new data from the form 

Call mudtCon.Update(txtConstraint, mudtConType, txtComment) 
' update the text in the list box 

mlstListBox.List(mlstListBox.Listlndex) = mudtCon. Constraints tring 
Else 

* Add the new constraint 

Set mudtCon = mudtModel. Constraints. Add(txtConstraint, True, _ 

mudtConType, txtComment) 
With mlstListBox 

' Add the new constraint to the list box 

Call .Addltem(mudtCon.ConstraintString) 

' Set ItemData to index value of the variable object 

JtemData(.ListCount - 1) = mudtCon.index 

' Check the check box 

.Selected(.ListCount - 1) = True 
End With 
End If 

Call fiinTCA.AddUndefmedVariables(txtConstraint) 
Unload Me 
End Sub 
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Private Sub cmdConCancel_ClickO 




Unload Me 
5 End Sub 
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' EditConstraint.frm 

VERSION 5.00 

Begin VB.Form frmEditText 

BorderStyle = 1 'Fixed Single 
5 ClientHeight = 1455 

ClientLefl = 45 

ClientTop = 330 

ClientWidth = 4785 

LinkTopic - "Forml" 
10 MaxButton = 0 'False 

MinButton = 0 'False 

ScaleHeight = 1455 

ScaleWidth = 4785 

StartUpPosition = 3 'Windows Default 
1 5 Begin VB . CommandButton cmdEditTextOK 





Caption 


= "OK" 




Default 


= -1 'True 




Height 


= 495 




Left 


= 3360 


i 


Tablndex 


= 2 




Top 


= 120 
= 1215 




Width 




End 





Begin VB. CommandButton cmdEditTextnCancel 
im Caption = "Cancel" 

I Height = 495 

5 Left = 3360 

^ Tablndex = 1 

Top = 720 

3^ Width = 1215 

g End 

Begin VB . TextBox txtEditText 
Alignment = 2 'Center 
Height = 375 
35 Left = 240 

Tablndex = 0 
Top = 120 

Width = 2895 
End 
40 End 

Attribute VB_Name = "frmEditText" 
Attribute VBGlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
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Attribute VB_Exposed = False 
Option Explicit 

* These are used as references to the ListBox in frmTCA currently being editted 
Public IstListBox As ListBox 
5 Public intind As Integer 

Private Sub cmdEditTextnCancel_Click() 

Unload Me 
End Sub 

Private Sub cmdEditTextOK_Click() 
1 0 IstListBox. Addltem txtEditText.Text 

IstListBox.Removeltem intind 

Unload Me 
End Sub 
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' Forml.frm 
VERSION 5.00 
Begin VB.Form Forml 
Caption = "Forml" 
5 ClientHeight = 4050 

ClientLeft = 60 
ClientTop = 345 
ClientWidth = 5595 
LinkTopic = "Forml" 
10 ScaleHeight = 4050 

ScaleWidth = 5595 
StartUpPosition = 3 'Windows Default 
Begin VB.CommandButton Commandl 
Caption = "Clear" 
15 Height = 1455 

Left - 3720 
Tablndex = 2 
Top = 2520 

hi Width = 1455 

2^ End 
iji Begin VB .TextBox Text 1 
4^ Height = 855 

3^ Left = 600 

4= Tablndex = 1 

25D Text = "Textl" 

^ Top - 960 

£j Width = 2175 

'Jf End 

Begin VB.CommandButton cmdRun 
34' Caption = "Run" 

if Height = 1335 

Left = 3720 
Tablndex = 0 
Top = 960 

35 Width = 1455 

End 
End 

Attribute VBName = "Forml " 
Attribute VBGlobalNameSpace = False 
40 Attribute VBCreatable = False 

Attribute VBPredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
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Private Sub cmdRun_Click() 

Dim udtP As New Prolog 
Dim IngR As Long 

If udtP.StartProlog("hlp41ib.p4") = False Then 

Call MsgBox("Prolog failure on startup", vbExclamation, "Error") 
End If 

Call udtP.AddVariable("int(I),[520<=I<=590 step 5], int(I2),[I + 5<=I2<=I + 30 step 1]") 
IngR = udtP.SolveConstraintsOrdered( 1 ) 
Textl = Str(lngR) 
End Sub 

Private Sub Commandl_CIick() 

Textl = "" 
End Sub 
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' fnnAbout.frm 
VERSION 5.00 
Begin VB.Form frmAbout 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "About TCA" 
ClientHeight - 2610 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 4440 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 ■ 'False 
ScaleHeight = 2610 
15 ScaleWidth = 4440 

ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.CommandButton cmdOK 
y Caption = "OK" 

2^^ Height = 495 

Jl-i Left = 3120 

£ Tablndex = 1 

h Top = 120 

4" Width =1215 

lii End 
=_ Begin VB. Label Ibl Version 

Height = 255 
i Left = 240 

^ Tablndex = 2 

3^ Top = 2160 

Width = 2295 
End 

Begin VB. Label Label 1 
Caption = "TCA is a collaborative development of the Assessment and Research 
35 Divisions." 

Height = 615 
Left = 240 

Tablndex = 0 
Top = 1320 

40 Width = 2535 

End 

Begin VB. Image imaETS 
BorderStyle = 1 'Fixed Single 
Height = 780 
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Left = 960 

Picture = "fimAbout.frx":0000 
Top = 240 

Width =1275 
End 
End 

Attribute VB Name = "frmAbout" 
Attribute VB_GlobalNameSpace = False 
Attribute VBCreatable = False 
Attribute VBPredeclaredld = True 
Attribute VBExposed = False 
Option Explicit 

Private Sub cmdEasterEgg_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As 
Single) 

If Button = vbRightButton Then 

' display easter egg 

Beep 
End If 

End Sub 

Private Sub cmdOK_ClickO 

Unload Me 
End Sub 

Private Sub Form_Load() 

IblVersion = frmSplash.lblVersion 
End Sub 

Private Sub imaETS_DblClickO 

' display easter egg 
Beep 

End Sub 



' fhnAttributes.frm 
VERSION 5.00 
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Begin VB.Form frmAttributes 

BorderStyle = 4 'Fixed ToolWindow 

Caption = "Family Attributes" 

ClientHeight = 1590 
5 ClientLeft = 45 

ClientTop = 285 

ClientWidth = 4305 

LinkTopic = "Forml" 

LockControls = -1 'True 
10 MaxButton = 0 'False 

MinButton = 0 'False 

ScaleHeight = 1590 

ScaleWidth = 4305 

ShowInTaskbar = 0 'False 
15 StartUpPosition = 1 'CenterOwner 

Begin VB.ComboBox cboProximity 





Height 


= 315 




ItemData 


= "frmAttributes.frx":0000 


n 


Left 


= 240 


List 


= "frmAttributes.frx":000D 




Style 


= 2 'Dropdown List 


Hsr ! 


Tablndex 


= 4 




Top 


= 360 




Width 
End 


= 1935 




Begin VB.OptionButton optGeneric 




Caption 


= "Generic" 




Height 


= 195 




Index 


= 0 




Left 


= 120 




Tablndex 


= 3 




Top 


= 1035 




Value 


= -1 'True 




Width 


= 975 


35 


End 





Begin VB.OptionButton optGeneric 

Caption = "Non-generic" 

Height = 195 

Index = 1 
40 Left = 1080 

Tablndex = 2 

Top = 1035 

Width = 1455 
End 

45 Begin VB.CommandButton cmdCancel 
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Caption = "Cancel" 
Height = 495 
Left = 3000 

Tablndex = 1 

5 ToolTipText = "Click here to return without saving these family attributes." 

Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cmdOK 
10 Caption = "OK" 

Default = -1 'True 

Height = 495 

Left - 3000 

Tablndex =0 
15 ToolTipText = "Click here to save these family attributes." 

Top = 120 

Width = 1215 
End 

Begin VB.Label Ibl 
iki Caption = "Variant proximity" 

1 Height =255 

yj Left = 240 

j= Tablndex = 5 

J Top = 120 

2|^ Width =1335 

End 
s End 

O Attribute VB_Name = "fimAttributes" 
^ Attribute VBGlobalNameSpace = False 
3 P Attribute VBCreatable = False 

Attribute VB_PredeclaredId = True 
S Attribute VB_Exposed = False 

Option Explicit 

Private mblnOK As Boolean 

35 Private mblnGeneric As Boolean 

Private mudtProximity As Proximity 

Private Sub Fonn_Load() 

mblnOK = False 

cboProximity.Listlndex = fhnTCA.Family.Proximity 
40 If frmTCA.Family.Generic Then 
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optGeneric(O) = True 
Else 

optGeneric(l) = True 
End If 

mblnGeneric = frmTCA.Family.Generic 
mudtProximity = fraiTCA.Family.Proximity 

End Sub 

Public Property Get ProximityQ As Proximity 

Proximity = mudtProximity 
End Property 

Public Property Get GenericQ As Boolean 

Generic = mblnGeneric 
End Property 

Private Sub cmdOK_Click() 

mblnOK - True 

Unload Me 
End Sub 

Private Sub cmdCancel_Click() 

Unload Me 
End Sub 

Public Property Get 0K() As Boolean 

OK = mblnOK 
End Property 

Private Sub cboProximity_Click() 

mudtProximity = cboProximity.Listlndex 



End Sub 

Private Sub optGeneric_Click(Index As Integer) 

mblnGeneric = optGeneric(O) 
End Sub 
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' frmComments.frm 
VERSION 5.00 
Begin VB.Form frmComments 
BorderStyle = 4 'Fixed ToolWindow 
5 Caption = "Comments" 

ClientHeight = 3765 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 5250 
10 LinkTopic = "Forail" 

LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 3765 
15 ScaleWidth = 5250 

ShowInTaskbar = 0 'False 
StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton cmdCancel 
Caption = "Cancel" 
2|i Height = 495 

yi Left - 3960 

4° Tablndex = 2 

TooITipText = "Click here to save these family attributes. 
4= Top = 720 

im Width = 1215 

End 

Begin VB.CommandButton cmdOK 
Caption = "OK" 
Default = -1 'True 
3^1 Height = 495 

g Left = 3960 

Tablndex = 1 

TooITipText = "Click here to save these family attributes. 
Top = 120 

35 Width = 1215 

End 

Begin VB.TextBox txtComment 

Height = 3495 

Left = 120 
40 MultiLine = -1 'True 

Tablndex = 0 

Top = 120 

Width = 3735 
End 
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End 

Attribute VB_Name = "frmComments" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Private mstrComment As String 

Public Property Get CommentQ As String 

Comment = mstrComment 

End Property 

Public Property Let Comment(ByVal strNewValue As String) 

txtComment = strNewValue 
mstrComment = strNewValue 

End Property 

Private Sub cmdCancel_Click() 

Unload Me 
End Sub 

Private Sub cmdOK_Click() 

mstrComment = txtComment 
Unload Me 

End Sub 
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' fimDifficulty.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFCO-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Begin VB.Form frmDifficulty 
BorderStyle = 4 'Fixed ToolWindow 
ClientHeight = 8730 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 6855 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 8730 
ScaleWidth = 6855 
ShowInTaskbar = 0 'False 
StartUpPosition = 2 'CenterScreen 
Begin VB.CheckBox chkRoute 

Caption = "Route to TCS" 

Height = 375 

Left = 2640 

Tablndex = 33 

Top = 1800 

Width = 1935 
End 

Begin VB.ComboBox cboKey 



Height 


= 315 


ItemData 


= "frmDifficulty.frx":0000 


Left 


= 2640 


List 


= "fiTnDifficulty.frx":0013 


Style 


= 2 'Dropdown List 


Tablndex 


= 30 


Top 


= 1200 


Width 


= 615 



End 

Begin VB.CheckBox chkCalcDifficulty 

Caption = "Calculate difficulty" 

Height = 255 

Left = 240 

Tablndex = 27 

Top = 3600 

Value = 1 'Checked 

Width = 1935 
End 
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Begin VB.ComboBox cboDeliveryMode 



Height 


= 315 


ItemData 


= "frmDifficulty.frx":0026 


Left 


= 2640 


List 


= "frmDifficulty.frx":0030 


Style 


= 2 'Dropdown List 


Tablndex 


= 25 


Top 


= 480 


Width 


= 1695 



10 End 

Begin VB.ComboBox cboDomain 



15 



Height 


= 315 


ItemData 


= "frmDifficulty.frx":003E 


Left 


= 240 


List 


= "frmDifficulty.fi:x":004E 


Style 


= 2 'Dropdown List 


Tablndex 


= 18 


Top 


= 1200 


Width 


= 1695 



2^^ End 
% Begin VB.OptionButton optNature 





Caption 


= "Pure" 




Height 


= 375 




Index 


= 0 




Left 


= 240 




Tablndex 


= 17 




Top 


= 1800 




Value 


= -1 'True 




Width 


= 735 



3W End 

Begin VB.OptionButton optNature 
y Caption = "Real" 

Height = 375 

Index = 1 

35 Left = 1200 

Tablndex = 16 

Top = 1800 

Width =735 
End 

40 Begin VB.CommandButton cmdOK 

Caption = "OK" 

Default = -1 'True 

Height = 495 

Left = 5520 
45 Tablndex = 8 
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ToolTipText = "Click here to save changes and return." 
Top = 240 

Width = 1215 
End 

5 Begin VB.CommandButton cmdCancel 

Caption = "Cancel" 
Height = 495 
Left = 5520 

Tablndex = 7 
10 ToolTipText = "Click here to save changes and return." 

Top = 840 

Width = 1215 
End 

Begin VB.TextBox txtBatchId 
15 Height = 315 

Left = 240 
Tablndex = 0 
Top = 480 

Width = 1695 
2Q5 End 
yi Begin ComctlLib. Slider sldTDEstimate 





Height 


375 




Left 


480 




Tablndex 


= 20 


if: 


Top = 


2760 




Width 


3975 




_ExtentX 


= 7011 




ExtentY 


= 661 




_Version 


= 327682 




LargeChange 


= 1 




Min = 


1 




Max 


5 




SclStart 


1 




Value = 


1 


35 


End 





Begin VB.Frame fraPredDiff 

Caption = "Predicted Difficulty" 

Height = 1575 

Left = 480 
40 Tablndex = 10 

Top = 6720 

Width = 4575 

Begin ComctlLib. Slider sldDiffEstimate 
Height = 375 
45 Left = 240 
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Tablndex = 11 

Top = 720 

Width = 3975 

_ExtentX = 7011 

5 _ExtentY = 661 

Version = 327682 

Min = 1 

Max = 5 

SelStart = 1 

10 Value = 1 
End 

Begin VB.Label IbllRTValue 

Height =255 

Left = 1080 

15 Tablndex = 32 

Top = 360 

Width = 3015 

End 

Cli Begin VB .Label IblPredEasy 

201 Caption = "Easy" 

01 Height = 255 

U1 Left = 3840 

4" Tablndex = 15 

J3 Top = 1200 

2f Width = 615 
End 

L Begin VB.Label IblPredMed 

^ Caption = "Medium" 

n Height = 255 

^, Left = 1920 

h Tablndex = 14 

C5 Top = 1200 

Width =855 
End 

35 Begin VB.Label IblPredDiff 

Caption = "Difficult" 

Height = 255 

Left = 240 

Tablndex = 13 

40 Top = 1200 

Width =735 
End 

Begin VB.Label IblIRT 

Caption = "IRTb:" 

45 Height = 255 
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15 



Left = 360 

Tablndex = 12 

Top = 360 

Width = 495 
End 
End 

Begin VB. Frame fraGREDiff 



Caption 


= "ORE Difficulty " 


Height 


= 4575 


Left 


= 240 


Tablndex 


= 2 


Top 


= 3960 


Width 


= 5055 


Begin VB.ComboBox cboGREConcept 


Height 


= 315 


ItemData 


= "frmDifficulty.frx":0080 


Left 


= 240 


List 


= "frmDifficulty.frx":0093 


Style 


= 2 'Dropdown List 


Tablndex 


= 28 


Top 


= 2160 


Width 


= 2055 


End 





2m 



Begin VB.ComboBox cboGRECog 

231 Height = 315 

ItemData = "frmDifficulty.frx":OOED 

U Left = 240 

% List = "frmDifficulty.fi^":OOFA 

fk Style = 2 'Dropdown List 

M Tablndex = 5 

a Top = 1440 

□ Width = 2055 
End 

Begin VB.ComboBox cboGREComp 

35 Height = 315 

ItemData = "frmDifficulty.frx":012D 

Left = 240 

List = "frmDifficulty.fiTc":013D 

Style = 2 'Dropdown List 

40 Tablndex = 3 

Top = 720 

Width = 2055 
End 

Begin VB.Label IblConcept 

45 Caption = "Concept:" 



VBSCA -66- 



Height = 255 
Left = 240 
Tablndex = 29 
Top = 1920 

5 Width = 975 

End 

Begin VB.Label IblGRECog 

Caption = "Cognition:" 

Height = 255 
10 Left = 240 

Tabhidex = 6 

Top = 1200 

Width = 975 
End 

1 5 Begin VB.Label IblGREComp 

Caption = "Computation:" 
Height = 255 
Left = 240 
f'i Tablndex = 4 

m Top = 480 

01 Width = 975 

Ul End 
J" End 

a;i Begin VB.Frame fraGMATDiff 
2^" Caption = " GM AT Difficulty" 

^ Height = 4575 

Left = 240 
^ Tablndex = 9 

U Top = 3960 

M Width = 5055 

h End 

Begin VB.Frame fraOther 
Height = 4575 
Left = 240 
35 Tablndex = 34 

Top = 3960 

Width - 5055 
End 

Begin VB.Label IblKey 
40 Caption = "Key:" 

Height = 255 

Left = 2640 

Tablndex = 31 

Top = 960 

45 Width = 975 
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End 

Begin VB.Label IblTarget 

Caption = "Target template:" 

Height = 255 

5 Left = 2640 

Tablndex = 26 

Top = 240 

Width = 1815 
End 

1 0 Begin VB.Label IblSlideDirections 

Caption = "Adjust the slide to estimated variant difficulty:" 

Height = 255 

Left = 600 

Tablndex = 24 

15 Top = 2400 

Width = 3615 
End 

Begin VB.Label IblTDDiff 

-ri Caption = "Difficult" 

2a3 Height = 255 

01 Left = 480 

W Tablndex = 23 

42 Top = 3240 

Width = 735 
2f End 
* Begin VB.Label IblTDMed 

Caption = "Medium" 

y Height = 255 

p{ Left . = 2160 

3QI Tablndex = 22 

b Top = 3240 

E Width = 855 
End 

Begin VB.Label IblTDEasy 

35 Caption = "Easy" 

Height = 255 

Left = 4080 

Tablndex = 21 

Top = 3240 

40 Width = 615 
End 

Begin VB.Label IblDomain 

Caption = "Domain:" 

Height = 255 

45 Left = 240 
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Tablndex = 19 
Top = 960 

Width = 975 
End 

5 Begin VB.Label LblBatch 

Caption = "Batch id:" 
Height = 255 
Left = 240 
Tablndex = 1 
10 Top = 240 

Width = 975 
End 
End 

Attribute VB_Name = "frmDifficulty" 
1 5 Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Q Option Explicit 

2Cf1 Dim mudtFamily As Family 

U1 Dim mudtClone As Clone 

4S Dim mudtDE As DifficultyEstimate 

W Dim mudtGreDE As GREDifficultyEstimate 

|: Dim mudtOmatDE As GMATDifficultyEstimate 

2|rj Dim mblnFormLoad As Boolean 

Pi Public Property Let Family(ByVal udtNewValue As Family) 

Q Set mudtFamily = udtNewValue 

End Property 

Public Property Let Clone(ByVal udtNewValue As Clone) 
30 Set mudtClone = udtNewValue 

End Property 

Private Sub Form_Load() 

Set mudtDE = mudtClone.Difffist 
35 mblnFormLoad = True 
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' if there's a key, prohibit input. 

If mudtFamily.ItemType = ptStandardMC Then 

cboKey.Enabled = False 
Else 

5 cboKey.Enabled = True 

End If 

' change form depending on program 
Select Case mudtFamily.Program 
10 CaseprGRE 

fraGREDiff.ZOrder 
fraPredDiff.ZOrder 
Case prGMAT 

fraGMATDiff.ZOrder 
15 fraPredDiff.ZOrder 
Case Else 

fraOther.ZOrder 
End Select 

2Q3 cboDomain.Listlndex = mudtClone.Domain 

01 txtBatchId = mudtClone.BatchID 

U] cboDeliveryMode.Listlndex = mudtClone.DeliveryMode 

' if key is not set, force "A" 
2£ If mudtClone.key = Then 
f cboKey = "A" 

Else 

.1=1 cboKey = mudtClone.key 

5 End If 

p If mudtClone.Nature = naPure Then 

CJ optNature(O) = True 

Else 

optNature(l) = True 
35 End If 

sldTDEstimate = mudtClone.TDEstimate 
chkRoute = mudtClone.IsRouted 
chkCalcDifficulty mudtClone.IsDifficultyCalculated 
40 chkCalcDifficulty_Click ' update screen accordingly 

If mudtClone.IsDifficultyCalculated Then 
Select Case mudtFamily.Program 
Case prGRE 

Set mudtGreDE = mudtClone.Difffist 
45 cboGREComp.Listlndex = mudtGreDE. Computation 
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cboGRECog.Listlndex = mudtGreDE.Cognition 
cboGREConcept.Listlndex = mudtOreDE. Concept 
CreateDifffist 
Case prGMAT 
5 Set mudtGmatDE = mudtClone.Difffist 

' nothing to load 
CreateDifffist 
Case prSAT 
' do nothing 
10 End Select 

Else 

cboGREComp.Listlndex = 0 
cboGRECog.Listlndex = 0 
cboGREConcept.Listlndex = 0 
15 End If 

mblnFormLoad = False 

f=i End Sub 

im Private Sub cmdOK_Click() 

4s CreateProfile 

^ Unload Me 

2% End Sub 

=H Private Sub cmdCancel_Click() 

p Unload Me 

End Sub 

30 Private Sub cboDomain ClickQ 
CreateProfile 
End Sub 

Private Sub cboGRECog_Click() 
CreateProfile 
35 End Sub 
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Private Sub cboGREComp_Click() 

CreateProfile 
End Sub 

5 Private Sub cboGREConcept_Click() 
CreateProfile 
End Sub 

Private Sub cboKey_ClickO 
10 CreateProfile 
End Sub 

fi Private Sub optNature_Click(Index As Integer) 

CreateProfile 
4=" End Sub 

4f Private Sub sldTDEstimate_Click() 

CreateProfile 

3 3 

2pj End Sub 

p Private Sub chkCalcDifficult)^Click() 

fi-aPredDiff.Enabled = CBool(chkCalcDifficulty) 
fi-aGREDiff.Enabled = CBool(chkCalcDifficulty) 
fi-aGMATDiff.Enabled = CBool(chkCalcDifficulty) 

25 IblGREComp.Enabled = CBool(chkCalcDifficulty) 

cboGREComp.Enabled = CBool(chkCalcDifficulty) 
IblGRECog.Enabled = CBool(chkCalcDifficulty) 
cboGRECog.Enabled = CBool(chkCalcDifficulty) 
IblConcept.Enabled = CBool(chkCalcDifficulty) 

30 cboGREConcept.Enabled = CBool(chkCalcDifficulty) 

IbllRT.Enabled = CBool(chkCalcDifficulty) 
IbllRTValue.Enabled = CBool(chkCalcDifficulty) 
IblPredDiff.Enabled = CBool(chkCalcDifficulty) 
IblPredEasy.Enabled = CBool(chkCalcDifficulty) 
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IblPredMed.Enabled = CBool(chkCalcDifficulty) 
IblPredDiff.Enabled = CBool(chkCalcDifficulty) 

If chkCalcDifficulty Then 
5 CreateProfile 
End If 

End Sub 

Private Sub CreateProfileQ 

' don't do it if were still loading form 
10 If mblnFormLoad Then Exit Sub 

mudtClone.Program = mudtFamily.Program 

mudtClone.Domain = cboDomain.Listlndex 

mudtClone.BatchID = txtBatchId 

mudtClone.DeliveryMode = cboDeliveryMode.Listlndex 
l^i mudtClone.key = cboKey 
.ji If optNature(O) = True Then 
01 mudtClone.Nature = naPure 

U1 Else 

M mudtClone.Nature = naReal 

im End If 
4^ mudtClone.IsRouted = chkRoute 

mudtClone.TDEstimate = sldTDEstimate 

3 

% mudtClone.IsDifficultyCalculated = chkCalcDifficulty 

2fr If ChkCalcDifficulty Then 
pi CreateDiffEst 
5 End If 

End Sub 

Private Sub CreateDifffist() 

30 If mudtClone.IsDifficultyCalculated Then 

Set mudtDE = Nothing 
Select Case mudtFamily.Program 
Case prGRE 

Set mudtGreDE = Nothing 
35 Set mudtGreDE = New GREDifficultyEstimate 

mudtGreDE.Domain = cboDomain.Listlndex 
mudtGreDE. Computation = cboGREComp.Listlndex 
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mudtGreDE.Cognition = cboGRECog.Listlndex 
mudtGreDE.Concept = cboGREConcept.Listlndex 
mudtGreDE.key = cboKey 
If optNature(O) = True Then 

mudtGreDE. Nature = naPure 
Else 

mudtGreDE.Nature = naReal 
End If 

mudtGreDE.ItemType = mudtFamily.ItemType 
' attach this GRE DE to the clone 
mudtCIone.DiffEst = mudtGreDE 
Set mudtDE = mudtGreDE 
SetPredDiffSlider 
Case prGMAT 

Set mudtGmatDE = Nothing 

Set mudtGmatDE = New GMATDifficultyEstimate 

mudtGmatDE.Domain = cboDomain.Listlndex 

mudtGmatDE.key = cboKey 

If optNature(O) = True Then 

mudtGmatDE. Nature = naPure 
Else 

mudtGmatDE. Nature = naReal 
End If 

mudtGmatDE.ItemType = mudtFamily.ItemType 
mudtGmatDE.TDDifffist = sldTDEstimate 
' attach this GMAT DE to the clone 
mudtCIone.DiffEst = mudtGmatDE 
Set mudtDE = mudtGmatDE 
SetPredDiffSUder 
Case prSAT 
' do nothing 
End Select 
Else ' opted not to calc difficulty 
mudtCIone.DiffEst = Nothing 
End If 

End Sub ^ . 

Private Sub SetPredDiffSliderQ 

Dim dblIRT As Double 

dblIRT = mudtDE.ComputeDifficulty 

IbllRTValue = Format(dblIRT, "0.#") 
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Select Case mudtFamily.Program 
Case prGRE 

IfdblIRK -1.001 Then 

sldDiffEstimate = 5 
ElselfdblIRK -0.238 Then 

sldDiffEstimate = 4 
Elself dblIRT < 0.379 Then 

sldDiffEstimate = 3 
ElseIfdblIRT< 0.931 Then 

sldDiffEstimate = 2 
Else 

sldDiffEstimate = 1 
End If 
Case prGMAT 
IfdblIRT< -0.919 Then 

sldDiffEstimate = 5 
Elself dblIRT < -0.093 Then 

sldDiffEstimate = 4 
Elself dblIRT < 0.565 Then 

sldDiffEstimate = 3 
Elself dblIRT < 1.197 Then 

sldDiffEstimate = 2 
Else 

sldDiffEstimate = 1 
End If 
End Select 



End Sub 



' frmDrag.frm 
VERSION 5.00 
Begin VB.Form fhnDrag 
Caption = "Window drag' control" 
ClientHeight = 1005 
ClientLeft = 60 
ClientTop = 345 
ClientWidth = 3060 
LinkTopic = "Forml" 
ScaleHeight = 1005 
ScaleWidth = 3060 
StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton Command2 

Caption = "Full Drag OFF" 

Height = 735 

Left = 1560 

Tablndex = 1 

Top = 120 

Width = 1215 
End 

Begin VB.CommandButton Commandl 

Caption = "Full Drag ON" 

Height = 735 

Left = 120 

Tablndex = 0 

Top = 120 

Width = 1215 
End 
End 

Attribute VB_Name = "fhnDrag" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VBPredeclaredld = True 
Attribute VB_Exposed = False 
Option Explicit 

Private Declare Function SystemParametersInfo Lib "user32" 
Alias "SystemParametersInfoA" (ByVal uAction As Long, 
By Val uParam As Long, ByRef IpvParam As Any, _ 
ByVal fiiWinlni As Long) As Long 

Private Const SPI_GETDRAGFULLWINDOWS = 38 
Private Const SPI_SETDRAGFULLWINDOWS = 37 
Private Const SPIF SENDWININICHANGE = 2 
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Public Function IsFuUWindowDragOnQ As Boolean 
Dim result As Long 
'Call API and check for successful call. 

If SystemParametersInfo(SPI_GETDRAGFULL WINDOWS, 0&, result, 0&) o 0 Then 
5 'Feature supported now check value of result. 

If result = 0 Then 

IsFullWindowDragOn = False 
Else 

IsFullWindowDragOn = True 
10 End If 

'Call failed, feature not supported. 
Else 

IsFullWindowDragOn = False 
End If 

End Function 

ji Private Sub TumOffFuUWindowDragQ 

U1 Dim result As Long 

^ result = SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0&, _ 
ByVal vbNuUString, SPIF SENDWININICHANGE) 

.1, End Sub 

. 

Private Sub TumOnFullWindowDragQ 
Dim result As Long 



Li. 



25 result = SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1 &, 

ByVal VbNuUString, SPIF_SENDWININICHANGE) 

End Sub 

Private Sub Commandl_ClickO 

TumOnF uU WindowDrag 
End Sub 

Private Sub Comniand2_Click() 



30 
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TumOffFullWindowDrag 



' frmlED.frm 
VERSION 5.00 
Begin VB.Form frmlED 
BorderStyle = 1 'Fixed Single 
Caption = "TCA Installation" 
ClientHeight = 1185 
ClientLeft = 45 
ClientTop = 330 
ClientWidth = 2475 
LinkTopic = "Forml " 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1185 
ScaleWidth = 2475 
StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton cmdOK 

Caption = "OK" 

Height = 375 

Left = 600 

Tablndex = 1 

Top = 720 

Width = 1215 
End 

Begin VB .Label Label 1 

Caption = "Setting lED files to read-only." 

Height = 255 

Left = 240 

Tablndex = 0 

Top = 240 

Width = 2055 
End 
End 

Attribute VBName = "frmlED" 
Attribute VB_GlobalNameSpace = False 
Attribute VBCreatable = False 
Attribute VB Predeclaredld - True 
Attribute VBExposed = False 
Option Explicit 

Private Sub cmdOK_Click() 

Unload Me 

End Sub 
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Private Sub Form_Load() 

Call ShellC'attrib +r C:\tcs\working\dscbt.ied", vbHide) 
Call ShellC'attrib +r C:\tcs\working\qccbt.ied", vbHide) 
Call ShellC'attrib +r C:\tcs\working\qcppt.ied", vbHide) 
Call ShellC'attrib +r C:\tcs\working\ssmccbt.ied", vbHide) 
Call ShellC'attrib +r C:\tcs\working\ssmcppt.ied", vbHide) 

End Sub 



VBSCA -80- 



' fhnlndexedString.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Begin VB.Form frmlndexedString 
BorderStyle = 4 'Fixed Tool Window 
ClientHeight = 2265 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 5835 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 2265 
ScaleWidth = 5835 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin ComctlLib.ListView Ivwindexed 

Height = 1815 

Left = 120 

Tablndex = 6 

Top = 120 

Width = 4215 

_ExtentX = 7435 

_ExtentY = 3201 

View = 3 

Arrange = 2 

LabelEdit = 1 

MultiSelect = -1 'True 

Label Wrap = -1 'True 

HideSelection = 0 'False 

_Version = 327682 

ForeColor = -2147483640 

BackColor = -2147483643 

BorderStyle = 1 

Appearance = 1 

Numltems = 2 

BeginProperty ColumnHeader(l) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
Key 

Object.Tag = "" 

Text = "Index" 

Object.Width = 529 
EndProperty 

BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFCO-4210102A8DA7} 
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Subltemlndex = 1 
Key = "" 

Object.Tag = "" 

Text = "Value" 
Object. Width = 6174 
EndProperty 
End 

Begin VB.CommandButton cmdAdd 
Caption = "Add" 
Height = 255 
Left = 120 
Tablndex = 5 

ToolTipText = "Click here to add a value to the end of the list." 
Top = 1900 

Width = 975 
End 

Begin VB.CommandButton cmdinsert 
Caption = "Insert" 
Height = 255 
Left = 1080 
Tablndex = 4 

ToolTipText = "Click here to insert a value before the currently selected value." 
Top = 1900 

Width = 1095 
End 

Begin VB.CommandButton cmdEdit 
Caption = "Edit" 
Height = 255 
Left = 2160 
Tablndex = 3 

ToolTipText = "Click here to edit the currently selected value." 
Top = 1900 

Width = 1095 
End 

Begin VB.CommandButton cmdRemove 
Caption = "Remove" 
Height = 255 
Left = 3240 
Tablndex = 2 

ToolTipText = "Click here to remove the selected value." 
Top = 1900 

Width = 1095 
End 

Begin VB.CommandButton cmdStrOK 
Caption = "OK" 
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Default = -1 'True 
Height = 495 
Left = 4440 

Tablndex = 0 
5 ToolTipText = "Click here to save changes and return." 

Top = 120 

Width = 1215 
End 

Begin VB.CommandButton cmdStrCancel 
10 Caption = "Cancel" 

Height = 495 
Left = 4440 

Tablndex = 1 

ToolTipText = "Click here to return without saving changes. 
15 Top = 720 

Width = 1215 
End 

Begin VB.Menu mnulndexed 
~s Caption = "Indexed" 

2Sj Visible = 0 'False 

ffl Begin VB.Menu mnuIndexedAdd 

ui Caption = "Add" 

M End 

J3 Begin VB.Menu mnulndexedlnsert 

2^. Caption = "Insert" 

-=<1 End 

Z^^ Begin VB.Menu ninuIndexedEdit 

y Caption = "Edit" 

% End 
3^1 Begin VB.Menu ninuIndexedRemove 

Caption = "Remove" 
g End 
End 
End 

35 Attribute VB_Name = "frmlndexedString" 

Attribute VB_GlobalNameSpace = False 

Attribute VB_Creatable = False 

Attribute VB_PredeclaredId = True 

Attribute VB_Exposed = False 
40 Option Explicit 

Private mudtModel As Model 
Private mudtEF As EditFlags 
Private mstrVariableName As String 
Private mcolStrings As Collection 
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Private mblnOK As Boolean 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
End Property 

Public Property Let AddEditFlag(ByVal udtNewValue As EditFlags) 

mudtEF = udtNewValue 
End Property 

Public Property Let SubStringCollection(ByVal colNewValue As Collection) 

Set mcolStrings = colNewValue 
End Property 

Private Sub cmdAdd ClickQ 

Call mnuIndexedAdd_Click 
End Sub 

Private Sub cmdEdit_Click() 

Call mnuIndexedEditClick 
End Sub 

Private Sub cmdInsert_Click() 

Call mnuIndexedInsert_Click 
End Sub 

Private Sub cmdRemove_Click() 

Call mnuIndexedRemove_Click 
End Sub 

Private Sub Fomi_Load() 
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Dim varS As Variant 
Dim IsiLI As Listltem 

Dim udtWAPI As New Win32API 

' enable full row select 

Call udtWAPLEnableListViewFullRowSelect(lvwIndexed) 
mblnOK = False 

frmlndexedString.Caption = "Editing substrings of string " & mstrVariableName 

If mudtEF - aeEdit Then 
With Ivwindexed 

For Each varS In mcolStrings 
Set IsiLI ^ .Listltems.Add 
UpdateListView 
IsiLLSubltems(l) = varS 
Next varS 
End With 
End If 

' prevent changes if model is frozen 
If mudtModel.IsFrozen Then 

cmdStrOK.Enabled False 

cmdAdd.Enabled False 

mnuIndexedAdd.Enabled = False 

cmdEdit.Caption = "Browse" 

mnuIndexedEdit.Caption = "Browse" 

cmdInsert.Enabled = False 

mnuIndexedlnsert.Enabled = False 

cmdRemove.Enabled = False 

mnuIndexedRemove. Enabled = False 
End If 

End Sub 

Public Property Let VariableName(By Val strNewValue As String) 

mstrVariableName = strNewValue 
End Property 

Public Property Get StringValueQ As String 
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Dim udtSS As New Substring 

udtSS.Deiimiter = Chr(STRING_DELIMITER) 
udtSS.StringCollection = mcolStrings 
StringValue = udtSS.StringValue 

End Property 

Public Property Get SubStringCoUectionQ As Collection 

Set SubStringCoUection = mcolStrings 
End Property 

Public Property Get OK() As Boolean 

OK = mblnOK 
End Property 

Private Sub cmdStrOK_Click() 

Dim Isiltem As Listltem 

Set mcolStrings = New Collection 

For Each Isiltem In IvwIndexed.Listltems 

Call mcolStrings.Add(lsiItem.SubItems(l)) 
Next Isiltem 

mblnOK = True 

Unload Me 

End Sub 

Private Sub cmdStrCancel_Click() 

Unload Me 
End Sub 

Private Sub mnuIndexedAdd_Click() 
With fimString 
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* set the model 
.Model = mudtModel 

* set the string 
.String Value = 
' set var name 

.VariableName = mstrVariableName & _ 
& Trim(Str(lvwIndexed.ListItems.Count + 1)) 

* do it 

.Show vbModal 
If .OK = False Then Exit Sub 
End With 

Dim IsiNewItem As Listltem 

Set IsiNewItem = IvwIndexed.Listltems.Add 
UpdateListView 

IsiNewItem. Subltems(l) = frmString. String Value 
End Sub 

Private Sub mnuIndexedEdit_Click() 

With frmString 
' set the model 
.Model = mudtModel 
' set the string 

.StringValue = IvwIndexed.Selectedltem.Subltems(l) 

* set var name 

.VariableName = mstrVariableName & _ 

& Trim(Str(lvwIndexed.SelectedItem.Index)) 
*do it 

.Show vbModal 
If .OK = False Then Exit Sub 
End With 

IvwIndexed.Selectedltem.Subltems(l) = frmString. StringValue 
End Sub 

Private Sub mnuIndexedInsert_Click() 

If IvwIndexed.Selectedltem Is Nothing Then Exit Sub 

With frmString 

* set the Model 



VBSCA -87- 



.Model = mudtModel 
' set the string 
.StringValue = "" 
' set var name 

.VariableName = mstrVariableName 
'do it 

.Show vbModal 
If .OK = False Then Exit Sub 
End With 

Dim IsiNewItem As Listltem 

Set IsiNewItem = IvwIndexed.Listltems.Add(lvwIndexed.Selectedltem.Index) 
UpdateListView 

IsiNewItem. Subltems(l) = frmString. String Value 
End Sub 

Private Sub mnuIndexedRemove_Click() 

If IvwIndexed.Selectedltem Is Nothing Then Exit Sub 

Call IvwIndexed.Listltems.Remove(lvwIndexed.SelectedltemJndex) 
UpdateListView 

End Sub 

Private Sub UpdateListViewQ 
Dim inti As Integer 

For intI = 1 To IvwIndexed.Listltems. Count 

lvwIndexed.ListItems.Item(intI).Text = Str(intl) 
Next intI 

End Sub 
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' frmNew.frm 
VERSION 5.00 
Begin VB.Form frmNew 
BorderStyle = 4 'Fixed ToolWindow 
Caption = "New family properties" 
ClientHeight = 1740 
ClientLefl = 45 
ClientTop = 285 
ClientWidth = 6240 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight =1740 
ScaleWidth = 6240 
ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.CommandButton cmdCancel 

Cancel = -1 'True 

Caption = "Cancel" 

Height = 495 

Left = 4800 

Tablndex = 9 

Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cmdOK 

Caption = "OK" 

Default = -1 'True 

Height = 495 

Left = 4800 

Tablndex = 8 

Top = 120 

Width = 1215 
End 

Begin VB.OptionButton optGeneric 

Caption = "Non-generic" 

Height = 195 

Index = 1 

Left = 3240 

Tablndex = 7 

Top = 1150 

Width = 1455 
End 



Begin VB.OptionButton optGeneric 
Caption = "Generic" 
Height = 195 
Index = 0 
5 Left = 2280 

Tablndex = 6 
Top = 1150 

Value = -1 'True 
Width = 975 
10 End 

Begin VB.ComboBox cboProximity 





Height 


= 315 




ItemData 


= "fhnNew.frx":0000 




Left 


= 2280 


15 


List 


= "fiTnNew.frx":OOOD 




Style 


= 2 'Dropdown List 




Tablndex 


= 4 




Top 


= 360 




Width 


= 1935 



2^1 End 



2i: 
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Begin VB.ComboBox cboItemType 





Height 


= 315 




ItemData 


= "fiTnNew.frx":0024 




Left 


= 120 




List 


- "frmNew.frx":0031 




Style 


= 2 'Dropdown List 




Tablndex 


= 2 


•J 


Top 


= 1080 


Iff 


Width 


= 1935 



30ff End 



Begin VB.ComboBox cboProgram 



Height 


= 315 


ItemData 


= "fhnNew.frx":0072 


Left 


= 120 


List 


= "frmNew.frx":007F 


Style 


= 2 'Dropdown List 


Tablndex 


= 0 


Top 


= 360 


Width 


= 1935 



40 End 

Begin VB.Label Ibl 

Caption = "Variant proximity" 

Height = 255 

Left = 2280 
45 Tablndex = 5 
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Top = 120 

Width = 1335 
End 

Begin VB.Label IblltemType 

Caption = "Item type" 

Height = 255 

Left = 120 

Tablndex = 3 

Top = 840 

Width = 1335 
End 

Begin VB.Label IblProgram 
Caption = "Program" 
Height = 255 
Left = 120 
Tablndex = 1 
Top = 120 

Width = 1335 
End 
End 

Attribute VB_Name = "frmNew" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB PredeclaredId = True 
Attribute VB Exposed = False 
Option Explicit 

Private mblnOK As Boolean 

Private mudtProgram As Program 
Private mudtltemType As ItemType 
Private mudtProximity As Proximity 
Private mblnOeneric As Boolean 

Private Sub Form_Load() 

mblnOK = False 

' init combo boxes 
cboProgram.Listlndex = 0 
cboItemType.Listlndex = 0 
cboProximity.Listlndex = 0 



End Sub 



10 



Public Property Get 0K() As Boolean 

OK = mblnOK 
End Property 

Public Property Get ProgramQ As Program 

Program = mudtProgram 
End Property 

Public Property Get ItemTypeQ As ItemType 

ItemType = mudtltemType 
End Property 

f ^ Public Property Get ProximityQ As Proximity 
m Proximity = mudtProximity 

4^ End Property 

1^- Public Property Get GenericQ As Boolean 
Generic = mblnGeneric 
End Property 

Private Sub cboProgram_Click() 

mudtProgram - cboProgram.Listlndex 
20 End Sub 

Private Sub cboItemType_Click() 

mudtltemType = cboItemType.Listlndex 
End Sub 

Private Sub cboProximity_Click() 
25 mudtProximity = cboProximity.Listlndex 
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10 

• ■n 





End Sub 

Private Sub optGeneric_Click(Index As Integer) 

mblnGeneric = optGeneric(O) 
End Sub 

Private Sub cmdOK_Click() 

mblnOK = True 

Unload Me 
End Sub 

Private Sub cmdCancel_Click() 

Unload Me 
End Sub 
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' frmNewModel.frm 
VERSION 5.00 

Begin VB.Form fhnNewFamily 
BorderStyle = 4 'Fixed ToolWindow 
5 Caption = "New family" 

ClientHeight = 1350 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 4680 
10 LinkTopic = "Forml" 

LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1350 
15 ScaleWidth = 4680 

ShowInTaskbar = 0 'False 
StartUpPosition = 1 'CenterOwner 
Begin VB.OptionButton optModelType 
Caption = "Quantitative Comparision" 
tM Height = 255 

yi Index = 1 

jf Left = 480 

ij'l Tablndex = 4 

^ Top = 480 

2^ Width = 2535 

= . End 

*:f Begin VB.OptionButton optModelType 
5? Caption = "Data Sufficiency" 

Height = 255 
35^ Index = 2 

g Left = 480 

Tablndex = 3 
Top = 720 

Width = 2535 
35 End 

Begin VB.OptionButton optModelType 
Caption = "Standard Multiple Choice" 
Height = 255 
Index = 0 
40 Left = 480 

Tablndex = 2 
Top = 240 

Value = -1 'True 
Width = 2535 
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End 

Begin VB.CommandButton cmdCancel 
Caption = "Cancel" 
Height = 495 
5 Left = 3360 

Tablndex = 1 

ToolTipText = "Click here to return without opening creating a new model." 

Top = 720 

Width = 1215 
10 End 

Begin VB.CommandButton cmdNewCreate 

Caption = "Create" 

Default = -1 'True 

Height = 495 
15 Left = 3360 

Tahlndex = 0 

ToolTipText = "Click here to create the new family." 

Top = 120 

P Width = 1215 

25s End 
jl End 

yi Attribute VBName = "frmNewFamily" 
M Attribute VBGlobalNameSpace = False 

Attribute VBCreatable = False 
2«jJ Attribute VBPredeclaredId = True 

Attribute VBExposed = False 

Option ExpHcit 



Private mblnOK As Boolean 



' holds the item type 



3|3 Private mudtltemType As ItemType 
Public Property Get 0K() As Boolean 

OK = mblnOK 
End Property 

35 Public Property Get ItemTypeQ As ItemType 
ItemType = mudtltemType 
End Property 
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Private Sub cmdNewCreate_Click() 
mblnOK = True 
5 Unload Me 

End Sub 

Private Sub cmdCancel_Click() 
mblnOK = False 
10 Unload Me 

End Sub 

Private Sub optModelType_Click(Index As Integer) 
f=r, mudtltemType = Index 

End Sub 
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' frmProgram.frm 
VERSION 5.00 
Begin VB.Form frmProgram 
Caption = "Select the program" 
5 ClientHeight - 1350 

ClientLeft = 60 
ClientTop = 345 
ClientWidth = 3225 
LinkTopic = "Forml" 
10 LockControls = -1 'True 

ScaleHeight = 1350 
ScaleWidth = 3225 
StartUpPosition = 1 'CenterOwner 
Begin VB.OptionButton optProgram 
15 Caption = "SAT" 

Height = 195 
Index = 2 
m Left = 240 

dh Tablndex = 4 

2ii Top = 720 

0] Width = 1335 

4". End 

B egin VB . OptionButton optProgram 
f; Caption = "GMAT" 

2^^ Height = 195 

%^ Index = 1 

S Left = 240 

Tablndex = 3 
lI Top = 480 

3|i Width = 1335 

f1 End 

Begin VB.OptionButton optProgram 



35 



40 



Caption 


= "GRE" 


Height 


= 195 


Index 


= 0 


Left 


= 240 


Tablndex 


= 2 


Top 


= 240 


Value 


= -1 'True 


Width 


= 1335 



End 

Begin VB.CommandButton cmdCancel 
Caption = "Cancel" 
Height = 495 
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Left = 1920 
Tablndex = 1 

ToolTipText = "Click here to return." 
Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cmdOK 
Caption = "OK" 
Height = 495 
Left = 1920 
Tablndex = 0 

ToolTipText = "Click here to save the currently selected program and return." 
Top = 120 

Width = 1215 
End 
End 

Attribute VB_Name = "frmProgram" 
Attribute VBGlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VBPredeclaredId = True 
Attribute VBExposed = False 
Option Explicit 

Private mblnOK As Boolean 

Private mudtProgram As Program 

Public Property Get 0K() As Boolean 

OK = mblnOK 

End Property 

Public Property Get ProgramQ As Program 

Program = mudtProgram 
End Property 

Private Sub cmdOK_Click() 
mblnOK = True 
Unload Me 
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End Sub 

Private Sub cmdCancel_Click() 

mblnOK = False 

Unload Me 
End Sub 

Private Sub optProgram_Click(Index As Integer) 

mudtProgram = Index 
End Sub 
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' fimProgress.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFCO-4210102A8DA7}#1.2#0"; "COMCTL32.0CX" 
Begin VB.Form frmProgress 
BorderStyle = 1 'Fixed Single 
ClientHeight = 1110 
ClientLeft = 15 
ClientTop = 15 
ClientWidth = 4500 
ClipControls = 0 'False 
ControlBox = 0 'False 
LinkTopic = "Forml" 
LockControls = -1 'True 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1110 
ScaleWidth = 4500 
StartUpPosition = 2 'CenterScreen 
Begin ComctlLib.ProgressBar prbProgressBar 

Height = 255 

Left =240 

Tablndex = 0 

Top = 600 

Width = 3975 

_ExtentX = 7011 
ExtentY = 450 

_Version = 327682 

Appearance = 1 

Max = 500 

End 

Begin VB. Label IblProgress 
Alignment = 2 'Center 
BeginProperty Font 

Name = "MS Sans Serif 

Size = 8.25 

Charset = 0 

Weight = 700 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
Height = 255 
Left = 240 
Tablndex = 1 
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Top = 240 

Width = 3855 
End 
End 

Attribute VBName = "frmProgress" 
Attribute VB_GlobalNameSpace = False 
Attribute VBCreatable = False 
Attribute VBPredeclaredId = True 
Attribute VBExposed = False 
Option Explicit 



' frmProlog.frm 
VERSION 5.00 
Begin VB.Form frmProlog 

BorderStyle = 5 'Sizable ToolWindow 

ClientHeight = 900 

ClientLeft = 2775 

ClientTop = 3720 

ClientWidth = 4440 

LinkTopic = "Formr' 

LockControls = -1 'True 

MaxButton = 0 Talse 

MinButton = 0 'False 

ScaleHeight = 900 

ScaleWidth = 4440 

ShowInTaskbar = 0 'False 

StartUpPosition = 2 'CenterScreen 

Begin VB.CommandButton cmdAbort 



Caption 


= "Abort" 


Default 


= -1 'True 


Height 


= 495 


Left 


= 3120 


Tablndex 


= 0 


Top 


= 120 


Width 


= 1215 



End 

Begin VB. Label IblProlog 

Height = 495 

Left = 120 

Tablndex = 1 

Top = 120 

Width = 2655 
End 
End 

Attribute VB_Name = "fimProlog" 
Attribute VBGlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VBPredeclaredId = True 
Attribute VB_Exposed = False 

Option Explicit 

Private mblnAbort As Boolean 



Public Property Get AbortQ As Boolean 



Abort = mblnAbort 
End Property 
Public Sub KillQ 
5 Unload Me 

End Sub 

Private Sub Form_Load() 

mblnAbort = False 

10 End Sub 

Private Sub cmdAbort_Click() 

f =; mblnAbort = True 

^ Unload Me 

1^ • 

m End Sub 
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' frmSplash.frm 
VERSION 5.00 
Begin VB.Form frmSplash 
BorderStyle = 3 'Fixed Dialog 
5 ClientHeight = 4245 

ClientLeft =255 
ClientTop = 1410 
ClientWidth = 7380 
ClipControls = 0 'False 
10 ControlBox = 0 'False 

Icon = "frmSplash.frx":0000 
KeyPreview = -1 'True 
LinkTopic = "Form2" 
LockControls = -1 'True 
15 MaxButton = 0 'False 

MinButton = 0 'False 
ScaleHeight = 4245 
£1 ScaleWidth = 7380 
5 ShowInTaskbar = 0 'False 
2m StartUpPosition = 2 'CenterScreen 
U1 Begin VB.Frame fraSplash 
^ Height = 4050 

q Left = 120 

Tablndex = 0 
2^ Top = 60 

= , Width = 7080 

'% Begin VB.Image imgLogo 

BorderStyle = 1 'Fixed Single 
Height = 780 
3|3 Left = 600 

?1 Picture = "frmSplash.fiTc":OOOC 

Top = 720 

Width =1275 
End 

35 Begin VB.Label IblCopyright 

Caption = "Copyright 1999" 
BeginProperty Font 
Name = "Arial" 

Size = 8.25 

40 Charset = 0 

Weight = 400 
Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 



i=4 
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EndProperty 
Height = 255 
Left = 4560 
Tablndex = 3 
5 Top = 3480 

Width = 2415 
End 

Begin VB.Label IblCompany 
Caption = "Educational Testing Service" 
10 BeginProperty Font 

Name = "Arial" 
Size = 8.25 
Charset = 0 
Weight = 400 
15 Underline = 0 'False 

Italic = 0 'False 
Strikethrough = 0 'False 
EndProperty 
Height = 255 
255 Left = 4560 

m Tablndex = 2 

Ol Top = 3720 

4= Width = 2415 

41 End 
2# Begin VB.Label IblWaming 

''^^ Caption = "Proprietary and Confidential" 

i^. BeginProperty Font 

y Name = "Arial" 

U Size = 9.75 

30: Charset = 0 

f J Weight = 700 

□ Underline = 0 'False 

Italic = 0 'False 
Strikethrough = 0 'False 
35 EndProperty 

Height = 315 
Left = 240 
Tablndex = 1 
Top = 3600 

40 Width = 2775 

End 

Begin VB.Label IblVersion 
Alignment = 1 'Right Justify 
AutoSize - -1 'True 
45 Caption = "Version 1.25" 
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BeginProperty Font 
Name = "Anal" 
Size = 12 
Charset = 0 
Weight = 700 
Underline = 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 

EndProperty 

Height = 285 

Left = 5265 

Tablndex = 4 

Top = 2880 

Width = 1410 
End 

Begin VB.LabellblProductName 
AutoSize = -1 'True 
Caption = "Assistant" 
BeginProperty Font 
Name = "Arial" 
Size = 48 
Charset = 0 
Weight = 700 
Underline - 0 'False 
Italic = 0 'False 
Strikethrough = 0 'False 



EndProperty 




Height 


1125 


Left 


1440 


Tablndex 


= 6 


Top 


1560 


Width 


4320 



End 

Begin VB. Label IblCompanyProduct 
AutoSize = -1 True 
Caption = "Test Creation " 
BeginProperty Font 

Name = "Arial" 

Size = 18 

Charset = 0 

Weight = 700 

Underline = 0 Talse 

ItaUc = 0 Talse 

Strikethrough = 0 'False 
EndProperty 



Height 


= 435 


Left 


= 2400 


Tablndex 


= 5 


Top 


= 1080 


Width 


= 2400 



End 
End 
End 

Attribute VB_Name = "fhnSplash" 
Attribute VBGlobalNameSpace = False 
Attribute VBCreatable = False 
Attribute VBPredeclaredId = True 
Attribute VBExposed = False 

Option Explicit 

Public Sub UnloadMeO 

Unload Me 



End Sub 



' SetPrecision.frm 
VERSION 5.00 

Begin VB.Form frmSetPrecision 
BorderStyle = 4 'Fixed ToolWindow 
5 Caption . = "Set Precision" 

ClientHeight = 1965 
ClientLeft = 45 
ClientTop = 285 
ClientWidth = 3540 
10 LinkTopic = "Forml" 
MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 1965 
ScaleWidth = 3540 
15 ShowInTaskbar = 0 'False 

StartUpPosition = 2 'CenterScreen 
Begin VB.CommandButton cmdSetPrecisionDefault 
Caption = "Default" 
J: Height = 495 

2|i Left = 2160 

yi Tablndex = 3 

ToolTipText = "Click here to return to the default value for precision." 
43 Top = 1320 

4= Width - 1215 

25^3 End 

I,. Begin VB.CommandButton cmdSetPrecisionOK 
y Caption = "OK" 

U Default = -1 'True 

H Height = 495 

3|J Left = 2160 

p Tablndex = 2 

ToolTipText = "Click here to save the displayed value." 
Top = 120 

Width = 1215 
35 End 

Begin VB.CommandButton cmdSetPrecisionCancel 
Caption = "Cancel" 
Height = 495 
Left = 2160 
40 Tablndex = 1 

ToolTipText = "Click here to return without saving any changes to precision." 
Top = 720 

Width = 1215 



End 
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Begin VB.TextBox txtPrecision 
Height = 315 
Left = 120 
Tablndex = 0 
5 Text = ".1" 

Top = 120 

Width = 1815 
End 
End 

10 Attribute VBName = "frmSetPrecision" 
Attribute VBGlobalNameSpace = False 
Attribute VB Creatable = False 
Attribute VBPredeclaredId = True 
Attribute VBExposed = False 

15 Option Explicit 

Private Sub cmdSetPrecisionCancel_Click() 
Unload Me 

01 End Sub 

01 

2^= Private Sub cmdSetPrecisionDefault_Click() 
txtPrecision = ".001" 



^3 

s 



End Sub 

Private Sub cmdSetPrecisionOK_Click() 



25=1 fhnTCA.Precision = txtPrecision 

Q Unload Me 

End Sub 

Private Sub Form_Load() 
30 txtPrecision = frmTCA.Precision 

End Sub 

Private Sub txtPrecision_GotFocus() 

' Automatically select all text when TextBox gets focus 
35 Call txtSelectAll(txtPrecision) 

VBSCA-109- 



• 



End Sub 



VBSCA-110- 
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' String.frm 
VERSION 5.00 
Begin VB.Form frmString 
BorderStyle = 4 'Fixed ToolWindow 
5 ClientHeight = 2265 

ClientLeft = 45 
ClientTop = 285 
ClientWidth = 5835 
LinkTopic = "Forml" 
10 LockControls = -1 'True 

MaxButton = 0 'False 
MinButton = 0 'False 
ScaleHeight = 2265 
ScaleWidth = 5835 
15 ShowInTaskbar = 0 'False 

StartUpPosition = 1 'CenterOwner 
Begin VB.CommandButton cmdStrOK 
Caption = "OK" 
Jl Default = -1 'True 

m Height = 495 

U1 Left = 4440 

4= Tablndex = 1 

tfl ToolTipText = "Click here to save changes and return." 

4" Top = 120 

25'^ Width = 1215 

U End 

Begin VB.CommandButton cmdStrCancel 
=f Caption = "Cancel" 

tl Height = 495 

3§i Left = 4440 

n Tablndex = 2 

ToolTipText = "Click here to return without saving changes." 
Top = 720 

Width = 1215 
35 End 

Begin VB.TextBox txtString 
Height = 315 
Left = 240 
Tablndex = 0 
40 Top = 480 

Width = 3975 
End 
End 

Attribute VB_Name = "frmString" 
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Attribute VB_GlobalNanieSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private mudtModel As Model 
Private mstrVariableName As String 
Private mstrStringValue As String 
Private mblnOK As Boolean 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
End Property 

Public Property Let VariableName(ByVal strNewValue As String) 

mstrVariableName = strNewValue 
End Property 

Public Property Let StringValue(ByVal strNewValue As String) 

mstrStringValue = strNewValue 
End Property 

Public Property Get StringValueQ As String 

StringValue = mstrStringValue 
End Property 

Public Property Get 0K() As Boolean 

OK = mblnOK 
End Property 
Private Sub Form_Load() 

mblnOK = False 
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frmString. Caption = "Editing string " & mstrVariableName 

txtString = mstrStringValue 

If mudtModel.IsFrozen Then 
cmdStrOK.Enabled = False 
End If 

End Sub 

Private Sub cmdStrOK_Click() 

mblnOK = True 
StringValue = txtString 

Unload Me 

End Sub 

Private Sub cmdStrCancel_Click() 

Unload Me 
End Sub 

Private Sub txtString_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtString) 

End Sub 
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' TCA.FRM 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.0CX" 
5 Object = "{F9043C88-F6F2-101 A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.0CX" 
Begin VB.Form frmTCA 
Caption = "ETS Test Creation Assistant" 
ClientHeight = 8310 
ClientLeft = 165 
10 ClientTop = 735 

ClientWidth =11400 
LinkTopic = "Forml" 
LockControls = -1 'True 
ScaleHeight = 8310 
15 ScaleWidth =11400 

StartUpPosition = 3 'Windows Default 
Begin VB. Frame frmDummy 
Caption = "Common dialog anchor" 
5^ Height = 855 

2g Left = 2640 

yi Tciblndex = 3 

4= Top = 2280 

Visible = 0 'False 
4= Width = 2055 

2^3 Begin MSComDlg.CommonDialog cdlCD 

Left = 120 
^ Top = 240 

_ExtentX = 847 
ExtentY = 847 



36'; Version = 393216 



End 
End 

Begin VB .Frame fraWord 
Height = 8535 
35 Left = 120 

Tablndex = 1 
Top - 0 

Width = 6255 

End 

40 Begin TabDlg.SSTab sstMainTab 

Height = 8535 
Left = 6480 
Tablndex = 0 
Top = 0 
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10 



15 



2& 



35 



40 



Width = 5655 
_ExtentX = 9975 
_ExtentY = 15055 
_Version = 393216 
TabHeight = 520 

BeginProperty Font {0BE35203-8F91-1 1CE-9DE3-00AA004BB85 1 } 

Name = "MS Sans Serif ' 

Size = 8.25 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 

TabCaption(O) = "Family Overview" 
TabPicture(O) = "TCA.frx":0000 



45 



Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 
Tab(0).Contro 



IEnabled= -1 'True 
0)= "IblFamily" 

0) .Enabled= 0 'False 

1) = "imll" 

1) .Enabled= 0 'False 

2) = "IblDummy" 

2) .Enabled- 0 'False 

3) = "IblAccepted" 

3) .Enabled= 0 'False 

4) = "IstAccepted" 
:4).Enabled= 0 'False 

5) = "txtVariablize" 

5) .Enabled= 0 'False 
;6)= "treModels" 

6) .Enabled= 0 'False 

7) = "cmdSetAttributes" 

7) .Enabled= 0 'False 

8) = "IstDummy" 

8) .Enabled= 0 'False 

9) = "cmdDone" 

9) .Enabled= 0 'False 

10) = "cmdPrintBatch" 

10) .Enabled= 0 'False 

11) = "cmdTreeExtend" 

11) .Enabled= 0 'False 

12) = "cmdTreeRemove" 

12) .Enabled= 0 'False 

13) = "cmdAcceptedPaste" 
i3).Enabled= 0 'False 
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Tab(0).Control(14)= "cmdAcceptedCopy" 
Tab(0).Control(14).Enabled= 0 'False 
Tab(0).Control(l 5)= "cmdAcceptedEdit" 
Tab(0).Control(15).Enabled= 0 'False 
Tab(0).ControlCount= 16 
TabCaption(l) = "Model Workshop" 
TabPicture(l) = "TCA.frx":001C 
Tab(l).ControlEnabled= 0 'False 
Tab(l).Control(0)= "IblVariables" 
Tab( 1 ) .Control( 1 )= " IblCloningConstraints" 
Tab(l).Control(2)= "IblDistractor" 
Tab(l).Control(3)= "cmdExportConstraints" 
Tab(l).Control(4)= "cmdImportConstraints" 
Tab(l).Control(5)= "cmdSaveModel" 
Tab(l).Control(6)= "cmdTestAll" 
Tab(l).Control(7)= "IstConstraints(l)" 
Tab(l).Control(8)= "cmdVariableAdd" 
Tab(l).Control(9)= "cmdVariableEdit" 
Tab(l).Control(10)= "cmdVariableRemove" 
Tab(l).Control(l 1)= "cmdVariableTest" 
Tab(l).Control(12)= "cmdConstraintAdd(O)" 
Tab(l).Control(13)= "cmdConstraintEdit(O)" 
Tab( 1 ) . Control( 1 4)= "cmdConstraintRemove(O)" 
Tab(l).Control(l 5)= "cmdConstraintTest(O)" 
Tab( 1 ). ControK 1 6)= "cmdConstraintAdd( 1 )" 
Tab(l).Control(17)= "cmdConstraintEdit(l)" 
Tab(l).Control(l 8)= "cmdConstraintRemove(l)" 
Tab( 1 ).Control( 1 9)= "cmdConstraintTest( 1 )" 
Tab(l).Control(20)= "cmdPrintConstraints" 
Tab(l).Control(2 1)= "IstConstraints(O)" 
Tab(l).Control(22)= "IstVariables" 
Tab(l).Control(23)= "cmdComments" 
Tab(l).ControlCount= 24 
TabCaption(2) = "Generate Variants" 
TabPicture(2) = "TCA.frx":0038 
Tab(2).ControlEnabled= 0 'False 
Tab(2).Control(0)= "cmdDispMakeModel" 
Tab(2) . Control( 1 )= "cmdDispDiscard" 
Tab(2).Control(2)= "cmdDispDefer" 
Tab(2) . Control(3)= "cmdDisp Accept" 
Tab(2).Control(4)= "sldDifference" 
Tab(2).Control(5)= "IstDisposition" 
Tab(2) . Control(6)= "cmdPrintVariants" 
Tab(2).Control(7)= "cmdDisplayModel" 
Tab(2).Control(8)= "txtNum2Generate" 
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Tab(2).Control(9)= "cmdGenerate" 
Tab(2).Coiitrol(10)= "IblDiff 
Tab(2).Control(ll)= "Labell" 
Tab(2).Control(12)= "IblMed" 
5 Tab(2).Control(13)= "IblLow" 

Tab(2).Control(14)= "IblVariants" 
Tab(2).Control(15)= "LblNum Variants" 
Tab(2). ControlCount= 1 6 
Begin VB.CommandButton cmdComments 
10 Caption = "Comments" 

Height = 495 

Left = -70680 

Tablndex = 58 

ToolTipText = "Click here to print all variables and constraints." 
15 Top = 3720 

Width = 1215 
End 

Begin VB.ListBox IstVariables 
m Draglcon = "TCA.frx":0054 

M Height = 1635 

m ItemData = "TCA.frx":035E 

yi Left = -74760 

4 List = "TCA.frx":0360 

m Style = 1 'Checkbox 

2m Tablndex = 57 

=3 ToolTipText = "Left button click to select a constraint. Then right button click for 

■'t.^ constraint options." 
y Top = 720 

Width = 3855 
30f End 
h'l Begin VB.ListBox IstConstraints 

n Draglcon = "TCA.frx":0362 

Height = 1635 
Index = 0 
35 ItemData = "TCA.frx":066C 

Left = -74760 
List = "TCA.frx":066E 
Style = 1 'Checkbox 
Tablndex = 56 

40 ToolTipText = "Left button click to select a constraint. Then right button click for 

constraint options." 

Top = 3120 

Width = 3855 
End 

45 Begin VB.CommandButton cmdAcceptedEdit 
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Caption = "Edit Profile" 
Height = 255 
Left = 240 
Tablndex = 54 

5 ToolTipText = "Click here to edit the profile of the selected variant." 

Top = 7300 

Width = 1335 
End 

Begin VB.CommandButton cmdAcceptedCopy 
10 Caption = "Copy Profile" 

Height = 255 
Left - 1560 
Tablndex - 53 

ToolTipText = "Click here to copy the profile of the selected variant." 
15 Top = 7300 

Width =1335 
End 

Begin VB.CommandButton cmdAcceptedPaste 
Caption = "Paste Profile" 
2^1 Height = 255 

Left = 2880 
Tablndex = 52 

ToolTipText = "Click here to paste a profile onto the currently selected variants." 
43 Top = 7300 

2$^ Width = 1215 

'S3 End 

^_ Begin VB.CommandButton cmdPrintConstraints 

^•f Caption = "Print Constraints" 

i Height =495 

Left = -70680 
J==^ Tablndex =51 

ToolTipText = "Click here to print all variables and constraints." 
Top = 3120 

Width = 1215 
35 End 

Begin VB.CommandButton cmdDispMakeModel 
Caption = "Create Mdl." 
Height = 255 
Left = -71880 
40 Tablndex = 50 

ToolTipText = "Click here to create new children of the active model using the 
currently selected variants." 
Top = 6120 

Width = 975 
45 End 
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Begin VB.CommandButton cmdDispDiscard 
Caption = "Discard" 
Height = 255 
Left = -72840 

Tablndex = 49 

ToolTipText = "Click here to discard the currently selected variants." 
Top = 6120 

Width = 975 
End 

Begin VB.CommandButton cmdDispDefer 
Caption = "Defer" 
Height = 255 
Left = -73800 
Tablndex = 48 

ToolTipText = "Click here to defer the currently selected variants." 
Top = 6120 

Width = 975 
End 

Begin VB.ConmiandButton cmdDispAccept 
Caption = "Accept" 
Height = 255 
Left = -74760 
Tabhidex = 47 

ToolTipText - "Click here to accept the currently selected variants." 
Top = 6120 

Width = 975 
End 

Begin VB.CommandButton cmdTreeRemove 
Caption = "Remove" 
Height = 255 
Left = 2160 
Tablndex = 46 

ToolTipText = "Click here to remove a model." 
Top = 3720 

Width =1935 
End 

Begin VB.CommandButton cmdTreeExtend 
Caption = "Extend" 
Height = 255 
Left = 240 
Tablndex = 45 

ToolTipText = "Click here to create a new child of the selected model." 
Top = 3720 

Width = 1935 
End 
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Begin VB.CommandButton cmdConstraintTest 
Caption = "Test" 
Height = 255 
Index = 1 
5 Left = -71880 

Tablndex = 44 

ToolTipText = "Click here to test all enabled variables and distractor constraints." 

Top = 7200 

Width = 975 
10 End 

Begin VB.CommandButton cmdConstraintRemove 

Caption = "Remove" 

Height =255 

Index = 1 
15 Left = -72840 

Tablndex = 43 

ToolTipText = "Click here to remove a distractor constraint." 

Top = 7200 

Q Width = 975 

2Qij End 
g-'i Begin VB.CommandButton cmdConstraintEdit 

Ul Caption = "Edit" 

4= Height = 255 

^ Index = 1 

25I5 Left = -73800 

Tablndex = 42 

ToolTipText = "Click here to edit the currently selected distractor constraint." 
Top = 7200 

Width = 975 
3C End 
f 1 Begin VB.CommandButton cmdConstraintAdd 

3 Caption = "Add" 

Height = 255 
Index = 1 
35 Left = -74760 

Tablndex = 41 

ToolTipText = "Click here to add a distractor constraint." 

Top = 7200 

Width = 975 
40 End 

Begin VB.CommandButton cmdConstraintTest 

Caption = "Test" 

Height = 255 

Index = 0 
45 Left = -71880 
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Tablndex = 40 

ToolTipText = "Click here to test all enabled variables and variation constraints." 
Top = 4800 

Width = 975 
End 

Begin VB.CommandButton cmdConstraintRemove 
Caption = "Remove" 
Height = 255 
Index - 0 
Left = -72840 
Tablndex = 39 

ToolTipText = "Click here to remove the currently selected variation constraint." 
Top = 4800 

Width - 975 
End 

Begin VB.CommandButton cmdConstraintEdit 
Caption = "Edit" 
Height = 255 
Index = 0 
Left = -73800 
Tablndex = 38 

ToolTipText = "Click here to edit the currently selected variation constraint." 
Top = 4800 

Width .= 975 
End 

Begin VB.CommandButton cmdConstraintAdd 
Caption = "Add" 
Height = 255 
Index = 0 
Left = -74760 
Tablndex =37 

ToolTipText = "Click here to add a variation constraint." 
Top = 4800 

Width = 975 
End 

Begin VB.CommandButton cmdVariableTest 
Caption = "Test" 
Height = 255 
Left = -71880 
Tablndex = 36 

ToolTipText = "CUck here to test all enabled variables." 
Top = 2400 

Width = 975 
End 

Begin VB.CommandButton cmdVariableRemove 



VBSCA-121- 



Caption = "Remove" 
Height = 255 
Left = -72840 
Tablndex = 35 

5 ToolTipText = "Click here to remove the currently selected variable." 

Top = 2400 

Width = 975 
End 

Begin VB.CommandButton cmdVariableEdit 
10 Caption = "Edit" 

Height =255 
Left = -73800 
Tablndex = 34 

ToolTipText = "Click here to edit the currently selected variable." 
15 Top = 2400 

Width = 975 
End 

Begin VB.CommandButton cmdVariableAdd 
Caption = "Add" 
2^ Height =255 

m Left = -74760 

U'i Tablndex = 33 

£. ToolTipText = "Click here to add a variable." 

li Top = 2400 

251" Width = 975 

^3 End 

Begin VB.CommandButton cmdPrintBatch 
9 Caption = "Print Air- 

Si Height = 495 

3^: Left = 4320 

f=i Tablndex =31 

ToolTipText = "Click here to print all variants." 
Top = 4200 

Width = 1215 
35 End 

Begin VB.CommandButton cmdDone 
Caption = "Done" 
Height = 495 
Left = 4320 

40 Tablndex = 29 

ToolTipText = "Click here when you are done with this family and are ready to send it 
back to TCS." 

Top = 1320 

Width = 1215 



45 End 
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Begin ComctlLib. Slider sldDifference 
Height = 255 
Left = -73440 
Tablndex = 24 
5 ToolTipText - "Select the degree of randomization desired." 

Top = 1140 

Width = 1935 
_ExtentX = 3413 
ExtentY = 450 
10 _Version - 327682 

Max = 2 

SelStart = 2 
Value = 2 
End 

15 Begin VB.ListBox IstDisposition 

Height = 3570 

ItemData = "TCA.frx":0670 

Left = -74760 

List = "TCA.fiTc":0672 
2if MuhiSelect = 2 'Extended 

^ Tablndex =21 

£ri ToolTipText = "Left button click to select a variant. Then right button click for variant 

j= options." 

^ Top = 2520 

25|" Width = 3855 

%i End 

^ Begin VB.CommandButton cmdPrintVariants 

CJ Caption = "Print All" 

S Height = 495 

3(^r Left = -70680 

Tablndex = 20 

ToolTipText = "Click here to print all variants." 

Top = 2400 

Width = 1215 
35 End 

Begin VB.CommandButton cmdDisplayModel 

Caption = "Display Model" 

Height = 495 

Left = -70680 
40 Tablndex = 19 

ToolTipText = "Click here to view the active model." 

Top = 1320 

Width = 1215 
End 

45 Begin VB.ListBox IstDummy 
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Height 


= 255 


ItemData 


= "TCA.frx":0674 


Left 


= 4680 


List 


= "TCA.frx":0676 


Sorted 


= -1 'True 


Tablndex 


= 18 


Top 


= 7800 


Visible 


= 0 'False 


Width 


= 615 



10 End 

Begin VB.TextBox txtNum2 Generate 
Height =315 
Left = -74760 
Tablndex = 16 
15 ToolTipText = "Enter the number variants to generate here." 

Top = 1140 

Width = 855 
End 

Begin VB.CommandButton cmdSetAttributes 
2% Caption = "Set Attributes" 

Enabled = 0 'False 
Oi Height = 495 

i Left = 4320 

J3 Tablndex = 15 

2S|= ToolTipText = "Click here to reset the attributes for this model family." 

^3 Top = 720 

Width =1215 
y End 

'~l Begin ComctlLib.TreeView treModels 

3^ Draglcon = "TCA.frx":0678 

n Height = 2955 

P Left = 240 

Tablndex = 13 

ToolTipText = "Left button click on a model to select it. Then right button click for 
35 options." 

Top = 780 

Width = 3855 
_ExtentX = 6800 
_ExtentY =5212 
40 _Version = 327682 

LabelEdit = 1 
LineStyle = 1 
Style = 7 
Appearance = 1 
End 
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Begin VB.ListBox IstConstraints 
Draglcon = "TCA.frx":07C2 
Height = 1635 
Index = 1 
5 ItemData = "TCA.frx":OACC 

Left = -74760 
List = "TCA.frx":OACE 
Style = 1 'Checkbox 
Tablndex = 10 

10 ToolTipText = "Left button click to select a constraint. Then right button click for 

constraint options." 

Top = 5520 

Width = 3855 
End 

1 5 Begin VB . CommandButton cmdTest All 

Caption = "Test Air- 
Height = 495 
Left = -70680 
Tablndex = 8 

25| ToolTipText = "Click here to test all checked variables and constraints." 

m Top =1320 

Ul Width = 1215 

4 End 

'H Begin VB.CommandButton cmdSaveModel 

Caption = "Save Model" 
^ Height = 495 

I. Left = -70680 

y Tablndex = 7 

ToolTipText = "Click here to save this model." 
3g: Top = 720 

Width = 1215 



End 



Begin VB.CommandButton cmdlmportConstraints 
Caption = "Import Constraints" 
35 Height = 495 

Left = -70680 
Tablndex = 6 

ToolTipText = "Click here to import a variable/constraint set." 
Top = 1920 

40 Width = 1215 

End 

Begin VB.CommandButton cmdExportConstraints 
Caption = "Export Constraints" 
Height - 495 
45 Left = -70680 
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Tablndex = 5 

ToolTipText = "Click here to export a variable/constraint set." 
Top = 2520 

Width = 1215 
End 

Begin VB.CommandButton cmdGenerate 
Caption = "Generate" 
Height = 495 
Left = -70680 
Tablndex = 4 
ToolTipText = "Click here to generate variants." 
Top = 720 

Width = 1215 
End 

15 Begin VB.TextBox txtVariablize 



BackColor 


= &H8000000C& 


Height 


= 375 


Left 


= 5880 


Tablndex 


= 2 


Text 


= "Rob" 


Top 


= 4740 


Visible 


= 0 'False 


Width 


= 615 



€1 End 
2i° Begin VB.ListBox IstAccepted 

J3 Height = 2985 

ItemData = "TCA.frx":0AD0 

0 Left = 240 

1 List - "TCA.fi^":0AD2 
Sg: MultiSelect = 2 'Extended 

p Tablndex =55 

p ToolTipText = "Left button click on a variant to view it. Then right button click for 

options." 

Top = 4320 

Width = 3855 
End 

Begin VB .Label lb 1 Accepted 

Caption = "Accepted variants" 

Height = 255 
40 Left = 240 

Tablndex = 32 

Top = 4080 

Width = 2535 
End 

45 Begin VB.Label IblDiff 
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4^ 



3P 



Caption = "Prolog randomization:" 
Height - 255 

Left = -73440 
Tablndex = 28 

Top = 840 
Width = 1935 
End 

Begin VB.Label Label 1 



Caption 


= "High' 


Height 


= 255 


Left 


= -71760 


Tablndex 


= 27 


Top 


= 1440 


Width 


= 495 



15 End 

Begin VB.Label IblMed 
Caption = "Medium" 
Height = 255 

Left = -72720 
2&' Tablndex = 26 

U Top = 1440 

m Width =735 



End 

Begin VB.Label IblLow 



Caption 


= "Low' 


Height 


= 255 


Left 


= -73440 


Tablndex 


= 25 


Top 


= 1440 


Width 


= 495 



End 

Begin VB.Label IblDummy 
^" BorderStyle = 1 'Fixed Single 

Height = 375 
35 Left = 4680 

Tablndex = 23 
Top = 6840 

Visible = 0 'False 
Width = 615 
40 End 

Begin VB.Label IblVariants 
Caption = "Variants" 
Height = 255 
Left = -74760 
45 Tablndex = 22 
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Top = 2280 

Width = 2055 
End 

Begin ComctlLib.ImageList imll 
5 Left = 4680 

Top = 7200 

_ExtentX =1005 
_ExtentY = 1005 
BackColor = -2147483643 
10 Image Width =16 

ImageHeight = 16 
MaskColor = 12632256 
_Version = 327682 

BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
15 NumListlmages = 2 

BeginProperty Listlmagel {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
Picture = "TCA.frx":0AD4 
Key = "" 

=^ EndProperty 

BeginProperty Listlmage2 {0713E8C3-850A-101B-AFC0-42101O2A8DA7} 
5^ Picture = "TCA.frx":1026 

yi Key = "" 

4] EndProperty 
EndProperty 
25|; End 
Ul Begin VB. Label Lb INumVariants 

Caption = "Number:" 
y Height = 255 

;f Left = -74760 

3(rf Tablndex = 17 

Top = 900 

Width = 735 
End 

Begin VB. Label IblFamily 
35 Caption = "Family members" 

Height = 255 
Left = 240 
Tablndex =14 
Top = 540 

40 Width = 3615 

End 

Begin VB. Label IblDistractor 
Caption - "Distractor Constraints" 
Height = 255 
45 Left = -74760 
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15 



2{S' 



u 
3(f? 



35 



40 



Tablndex = 12 
Top = 5280 

Width = 2535 
End 

Begin VB.Label IblCloningConstraints 



= "Variation Constraints" 
= "TCA.frx":1578 , 
= 255 
= -74760 

= 11 
= 2880 
= 2535 



Caption 
Draglcon 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB.Label IblVariables 



= "Variables" 

= 255 
= -74760 

= 9 
= 480 

= 855 



Caption 
Height 
Left 

Tablndex 
Top 
Width 
End 
End 

Begin ComctlLib.StatusBar stbS 



= 2 'Align Bottom 
= 300 
= 0 

= 30 
= 8010 
= 11400 

= 20108 

= 529 



Align 
Height 
Left 

Tablndex 
Top 
Width 
_ExtentX 
_ExtentY 
SimpleText = "" 
_Version = 327682 

BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
NumPanels = 1 1 

BeginProperty Panell {0713E89F-850A-101B-AFC0-42101O2A8DA7} 
Alignment = 2 
AutoSize = 2 
Bevel = 0 
Object. Width = 2117 
MinWidth = 2117 
Text = "Program:" 
TextSave = "Program:" 
Key = "" 

Object.Tag = "" 
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EndProperty 

BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 1 

AutoSize = 2 

Object. Width = 1058 

MinWidth = 1058 

Key = 

Object.Tag = "" 

EndProperty 

BeginProperty PaneB {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 2 

AutoSize = 2 

Bevel = 0 

Object. Width = 1773 

MinWidth = 1764 

Text = "Family:" 

TextSave = "Family:" 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panel4 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 1 

AutoSize = 2 

Object. Width = 2646 

MinWidth = 2646 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panel5 {0713E89F-850A-101B-AFC0-4210102A8DA7} 

Alignment = 2 

AutoSize = 2 

Bevel = 0 

Object. Width = 2117 

MinWidth = 2117 

Text = "Attributes:" 

TextSave = "Attributes:" 

Key = "" 

Object.Tag = "" 

EndProperty 

BeginProperty Panel6 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
Alignment = 1 
AutoSize = 2 
Object. Width = 1058 
MinWidth = 1058 
Key = "" 



VBSCA -130- 




Object.Tag = "" 

EndProperty 

BeginProperty Panel? {0713E89F-850A-101B-AFC0-4210102A8DA7} 
Alignment = 1 
5 AutoSize = 2 

Object.Width = 1058 
MinWidth = 1058 
Key = 
Object.Tag = "" 

10 EndProperty 

BeginProperty PanelS {0713E89F-850A-101B-AFCO-4210102A8DA7} 



AutoSize = 2 
Object.Width = 1058 
MinWidth = 1058 
15 Key = "" 

Object.Tag = 
EndProperty 



BeginProperty Panel9 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
^ ^, Alignment = 2 

tM AutoSize = 2 

Bevel = 0 
[jl Object.Width = 2487 

J MinWidth - 2469 

• h Text = "Active Model:" 

251'= TextSave = "Active Model:" 

J3 Key = "" 

Object.Tag = "" 

EndProperty 

0 2f BeginProperty PanellO {0713E89F-850A-101B-AFC0-4210102A8DA7} 



Alignment = 1 
AutoSize = 2 
U Object.Width = 450 

MinWidth = 441 
Key = "" 

35 Object.Tag = "" 

EndProperty 



BeginProperty Panel 1 1 {07 1 3E89F-850A- 1 0 1 B- AFCO-42 1 0 1 02 A8DA7} 
Alignment = 1 
AutoSize = 2 

• 40 Object.Width = 2646 

MinWidth = 2646 
Key = "" 

Object.Tag = "" 

EndProperty 

• 45 EndProperty 
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End 

Begin VB.Menu ninuFile 
Caption = "File" 
Begin VB.Menu mnuFileNew 

Caption = "New" 
End 

Begin VB.Menu mnuFileOpen 

Caption = "Open" 
End 

Begin VB.Menu mnuFilelmportltem 

Caption = "Import Locked Item" 
End 

Begin VB.Menu mnuFileSaveAs 

Caption = "Save As" 

Visible = 0 'False 
End 

Begin VB.Menu mnuFileSave 

Caption = "Save" 

Visible = 0 'False 
End 

Begin VB.Menu nmuFilePrintSetup 

Caption = "Print Setup" 
End 

Begin VB.Menu mnuFileExit 

Caption = "Exit" 
End 
End 

Begin VB.Menu mnuHelp 

Caption = "Help" 

NegotiatePosition= 3 'Right 

Begin VB.Menu mnuHelp About 
Caption = "About" 

End 
End 

Begin VB.Menu mnuVariables 
Caption = "Variables" 
Visible = 0 'False 
Begin VB.Menu mnuVariables Add 

Caption = "Add" 
End 

Begin VB.Menu mnuVariablesEdit 

Caption = "Edit" 
End 

Begin VB.Menu mnuVariablesRemove 
Caption = "Remove" 



End 

Begin VB.Menu mnuVariablesRemoveAU 

Caption = "Remove All" 
End 

Begin VB.Menu mnuVariablesEnableAU 

Caption = "Enable All" 
End 

Begin VB.Menu ninuVariablesDisableAll 

Caption = "Disable All" 
End 

Begin VB.Menu mnuVariablesTest 

Caption = "Test" 
End 
End 

Begin VB.Menu mnuConstraints 
Caption = "Constraints" 
Visible = 0 'False 
Begin VB.Menu mnuConstraints Add 

Caption = "Add" 
End 

Begin VB.Menu mnuConstraintsEdit 

Caption = "Edit" 
End 

Begin VB.Menu mnuConstraintsRemove 

Caption = "Remove" 
End 

Begin VB.Menu mnuConstraintsRemoveAll 

Caption = "Remove All" 
End 

Begin VB.Menu mnuConstraintsEnableAll 

Caption = "Enable All" 
End 

Begin VB.Menu mnuConstraintsDisableAll 

Caption - "Disable All" 
End 

Begin VB.Menu mnuConstraintsTest 

Caption = "Test" 
End 
End 

Begin VB.Menu mnuDisp 
Caption = "Disposition" 
Visible = 0 'False 
Begin VB.Menu mnuDispAccept 

Caption = "Accept" 
End 



Begin VB.Menu mnuDispDefer 

Caption = "Defer" 
End 

Begin VB.Menu mnuDispDiscard 
5 Caption = "Discard" 

End 

Begin VB.Menu nmuDispMakeModel 

Caption = "Create Model" 
End 
10 End 

Begin VB.Menu mnuTree 
Caption = "Tree" 
Visible = 0 'False 
Begin VB.Menu mnuTreeExtend 
15 Caption = "Extend" 

Enabled = 0 'False 
End 

Begin VB.Menu mnuTreeRemove 
Caption = "Remove" 
2Qj-i End 
m End 

Ul Begin VB.Menu mnuAccepted 
4= Caption = "Accepted" 

Visible = 0 'False 
25?" Begin VB.Menu ninuAcceptedProfile 

J3 Caption = "Edit profile" 

hi Begin VB.Menu mnuAcceptedCopy 

S Caption = "Copy profile" 

3(ff Enabled = 0 'False 

a End 

h Begin VB.Menu mnuAcceptedPaste 

Caption = "Paste profile" 
Enabled = 0 'False 
35 End 
End 
End 

Attribute VB_Name = "frmTCA" 
Attribute VB_GlobalNameSpace = False 
40 Attribute VB_Creatable = False 

Attribute VBPredeclaredId = True 
Attribute VBExposed = False 
Option Explicit 

' contains family 
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Private mudtFam As Family 
' word 

Private mudtWord As MSWord 

' prolog activex 

Private mudtProlog As Prolog 

' needed for SetAUCheckboxes sub 
Private mlstCurrentListBox As ListBox 

' needed so frmConstraint know which kind of constraint to create 
Private mintConstrLBInd As Integer 

' used as a flag when mnuFilelmportLockedltem calls mnuFileNew 
Private mudtltemType As ItemType 

' holding area for copy / paste of variant profiles 
Private mudtClone As Clone 

' turn full window drag back on if this is TRUE 
Private mblnRestoreFullWindowDrag As Boolean 

Public Enum EditFlags 

aeNothing = 0 

aeAdd = 1 

aeEdit = 2 
End Enum 

Public Enum TestType 

tcTestVariables = 0 

tcTestVariationConstraints = 1 

tcTestDistractorConstraints = 2 

tcTestAU = 4 
End Enum 

' for importing/exporting variables and constraints 
Private Enum ConstraintRecordLayout 

crVariablelndex =1*4 byte long 

crConstraintlndex = 5 ' 4 byte long 

crVariables = 9 ' binary - variable size 
End Enum 

Private Enum Iconlmage 
imSnowflake = 1 
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imSun = 2 
End Enum 

* used to update status bar 
Private Enum Panellndex 
5 pnProgramCaption = 1 

pnProgramName = 2 
pnFamilyCaption = 3 
pnFamilyName = 4 
pnAttributesCaption = 5 
10 pnltemType = 6 

pnGeneric = 7 
pnProximity = 8 
pnActiveModelCaption = 9 
pnActiveModellcon = 10 
1 5 pnActi veModelName =11 

End Enum 

Public Property Get FamilyQ As Family 

m Set Family = mudtPam 

y. i 

^ End Property 

2^ Public Property Let Family(ByVal udtNewValue As Family) 

mudtFam = udtNewValue 
^- End Property 
U Private Sub cmdCancel_Click() 
End Sub 

25 Private Sub cmdAcceptedCopy_Click() 
Call mnuAcceptedCopy_Click 
End Sub 

Private Sub cmdAcceptedEdit_Click() 
Call mnuAcceptedProfile_Click 
30 End Sub 
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Private Sub cmdAcceptedPaste_Click() 

Call innuAcceptedPaste_Click 
End Sub 

Private Sub cmdComments_Click() 

frmComments.Comment = mudtFam. ActiveModel.Comments 
frmComments.Show vbModal 

mudtFam.ActiveModelComments = frmComments.Comment 
UpdateTab 1 ControlStates 
End Sub 

Private Sub cmdConstraintAdd_Click(index As Integer) 

mintConstrLBInd = index 
J5 Call mnuConstraintsAdd_Click 

01 

15U1 End Sub 

SIT 

J5 Private Sub cmdConstraintEdit_Click(index As Integer) 

mintConstrLBInd = index 
Call mnuConstraintsEdit_Click 

pj End Sub 

2(1=1 Private Sub cmdConstraintRemove_Click(index As Integer) 

Cj 

mintConstrLBInd = index 

Call mnuConstraintsRemove_Click 

End Sub 

Private Sub cmdConstraintTest_Click(index As Integer) 

25 mintConstrLBInd = index 

Call mnuConstraintsTest_Click 

End Sub 

Private Sub cmdDispAccept_Click() 
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Call mnuDispAccept_Click 
End Sub 

Private Sub cmdDispDefer_Click() 

Call mnuDispDefer_Click 
5 End Sub 

Private Sub cmdDispDiscard_Click() 

Call mnuDispDiscard_Click 
End Sub 

Private Sub cmdDisplayModel_Click() 
lO^T Call mudtFam.ActiveModel.OpenDoc(mudtWord) 

5 End Sub 

4^^ Private Sub cmdDispMakeModel_Click() 
4^ Call ninuDispMakeModeI_Click 
End Sub 

; f'i 

iSr! Private Sub cmdDone_Click() 

f =1 Dim inti As Integer 
£^ Dim udtClone As Clone 

Dim dMode As String 

Dim iType As String 
20 Dim key As String 

Dim Program As String 

Dim root As String 

Dim udtFamIni As New IniFile 

Dim udtProgress As New Progress 

25 If MsgBoxC'Prepare this family for export to TCS?", 

vbQuestion + vbYesNo) = vbNo Then 
Exit Sub 
End If 
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If mudtFam.ActiveModel Is Nothing Then 

' do nothing 
Else 

mudtFam.ActiveModel.WriteModel 
End If 

* close this so it can be copied to the out directory 
mudtFam.ActiveModelCloseDoc 

Call udtProgress.Init(mudtFam.Clones.Count + 2, "Preparing family for exporting to TCS...") 
udtProgress.Advance 

root = ExtractFileNameNoExt(mudtFam.FileName) 
udtFamlni.FN = OUT_DIRECTORY & root & ".ini" 

Select Case mudtFam.Program 
Case prGRE 

Program = "GRE" 

Case prGMAT 

Program = "GMAT" 

Case prSAT 

Program = "SAT" 

Case prMR 

Program - "MR" 
End Select 

Dim udtlnini As New IniFile 

udtlnlni.FN = left(mudtFam.FileName, Len(mudtFam.FileName) - 3) _ 
"ini" 

Dim strModelNo As String 

' started with a locked item (during this session) 
StrModelNo = udtInIni.GetProfileString("LockedItemData", _ 
"TCAModelNo") 

' Started with an existing family (during this session) 
If StrModelNo = "Not Found" Then 

StrModelNo - udtInIni.GetProfileString("Family", _ 
"TCAModelNo") 
End If 
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Call udtFamIni.SetKeyValuePair('TCAModelNo", strModelNo) 

Call udtFamIni.SetKeyValuePair("LockedAccnum", mudtFam.AccNum) 

Call udtFamlni.SetKeyValuePairC'Program", Program) 

Dim strProx As String 

Select Case mudtFam.Proximity 
Case prNear 

strProx = "close" 
Case prMedium 

StrProx = "medium" 
Case prFar 
StrProx = "far" 
End Select 

Call udtFamIni.SetKeyValuePair("Proximity", strProx) 

If mudtFam.Generic Then 

Call udtFamIni.SetKeyValuePair("Nature", "generic") 
Else 

Call udtFamIni.SetKeyValuePair("Nature", "non-generic") 
End If 

For Each udtClone In mudtFam. Clones 

udtClone.CloseDoc 

If udtClone. IsRouted = False Then 

dMode = "TCA" 
iType - "TCA" 

Call FileCopy(IN_DIRECTORY & udtClone.FileName, _ 
OUT_DIRECTORY & udtClone.FileName) 

Else 

If udtClone.DeUveryMode = dmPPT Then 

dMode = "PPT" 
Else 

dMode - "CBT" 
End If 

Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
Select Case mudtFam.ItemType 
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Case ptStandardMC 
IfdMode = "PPT" Then 
iType = "MC Item" 

Call genPPT_MultChoice(udtClone, key) 
Else 

iType = "QANTDISC" 
Call genCBT_MultChoice(udtClone, key) 
End If 

Case ptQuantComp 
IfdMode = "PPT" Then 

iType = "QC Discrete" 

Call genPPT_QuantComp(udtClone, key) 
Else 

iType = "QANTCOMP" 
Call genCBT_QuantComp(udtClone, key) 
End If 

Case ptDataSuff 

iType = "DATASUFF" 

Call genCBT_DataSuff(udtClone, key) 

End Select 

udtClone.CloneDoc.Close 
End If 

Dim udtClnIni As New IniFile 

root = ExtractFileNameNoExt(udtClone.FileName) 
Call udtFamIni.SetKeyValuePair("Variant", root) 

udtClnIni.FN = OUT_DIRECTORY & root & ".ini" 

Call udtChiIni.SetKeyValuePair("DeliveryMode", dMode) 
Call udtClnlni.SetKeyValuePairC'Key", udtClone.key) 
Call udtClnIni.SetKeyValuePair("ItemType", iType) 
CalludtClnIni.WriteProfileSection("Variant") 
Call udtClnIni.WriteProfileString("Exit", " ", " ") 

Set udtChiIni = Nothing 

udtProgress .Advance 
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Next udtClone 



' delete profiled variants from IstAccepted 
With IstAccepted 
inti = .ListCount - 1 
Do While intl>-l 

Set udtClone = mudtFam.Clones.Item(Str(.ItemData(intI))) 
If udtClone.IsRouted Then 

' remove the clone from the collection 
Call mudtFam.Clones.Remove(Str(.ItemData(intI))) 
' remove it from the list box 
Call .Removeltem(intl) 
End If 
intI = intI - 1 
Loop 
End With 

mudtFam.WriteFamily 

Dim fName As String 
Dim strWildCard As String 

For intI = 1 To treModels.Nodes.Count 
root = ExtractFileNameNoExt(treModels.Nodes.Item(intI)) 

fName = root & ".doc" 

Call udtFamhii.SetKeyValuePair("Member", fName) 

Call FileCopy(IN_DIRECTORY & fName, OUT_DIRECTORY & fName) 

fName = root & ".mdl" 

Call udtFamIni.SetKeyValuePair("Member", fName) 

Call FileCopy(IN_DIRECTORY & fName, OUT_DIRECTORY & fName) 

Ifintl = 1 Then 

fName = root & ".mdf 
StrWildCard = root & "* .*" 

Call udtFamIni.SetKeyValuePair("Member", fName) 
Call FileCopy(IN_DIRECTORY & fName, OUT_DIRECTORY & fName) 
End If. 

Next 

Call udtFamIni.WriteProfileSection("Family") 
Call udtFamIni.WriteProfileString("Exit", " ", " ") 
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ClearControls 

mudtWord.WordApp.Documents.Open FileName:=App.path & "\tcaclone.doc" 
mudtWord.WordApp.Documents.Close 

Kill IN_DIRECTORY & strWildCard 

If strModelNo o "Not Found" Then 

Kill IN_DIRECTORY & strModelNo & ".*" 
End If 

udtProgress.Advance 
UpdateTabOControlStates 
End Sub 

Private Sub genPPT_MultChoice(udtClone As Clone, itmKey As String) 
Dim docTCAModel As Document 

Set docTCAModel = mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

docTCAModel.Variables.Add "PROP_ACCNUM", "SSMCPPT" 

' mudtWord.WordApp.Run ("SetAccnum") 
mudtWord.WordApp.Run ("Startltem.Main") 

Dim tabchr As String 

tabchr = Chr(9) 

Dim destRange As Range 

Set destRange = docTCAModel. Content 

destRange.fmd.Style = "PPTStem" 

destRange. fmd.Execute FindText:=tabchr 

' MsgBox "PPT MultChoice" 

udtClone.CloneDoc.Bookmarks("tca_Stem"). Range. Copy 
destRange. Paste 

destRange. Borders.Enable = False 

destRange. ParagraphFormat.Leftlndent - InchesToPoints(0.25) 
destRange. Style = "PPTStem" 

Dim respRange As Range 
Dim abcde As String 
abcde = "ABCDE" 
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Dim i As Integer 
For i = 1 To 5 

Set respRange = udtClone.CloneDoc.Boolanarks("tca_Resp" & Mid(abcde, i, l)).Range 
respRange. start = respRange. start + 4 
5 respRange.Copy 

Set destRange = docTCAModel.Content 
destRange.find.Style = "PPTOptions" 

destRange.fmd.Execute FindText:="(" & Mid(abcde, i, 1) & ")" 
destRange.start = destRange. start + 4 
10 destRange.Paste 

destRange.Borders.Enable = False 

destRange.ParagraphFormat.Leftlndent = InchesToPoints(0.25) 
destRange. Style = "PPTOptions" 

Next 

I5S Dim key As String 

m key = udtClone.CloneDoc.Bookmarks("tca_Key").Range.Text 

til key = Mid(key, 8, 1) 

Jf, itmKey = key 

4" For i = 1 To 5 

2S3 If key = Mid(abcde, i, 1) Then 

key = Format(i) 
y Exit For 

iJ End If 

H Next 



2 f\ Dim keyRange As Range 
Dim keyStart As Long 
Set keyRange = docTCAModel.Content 
keyStart = keyRange.End - 1 

docTCAModel.Content.InsertAfter Text:=itmKey 
30 keyRange.SetRange start :=key Start, End:^docTCAModel.Content.End 

' docTCAModel.Bookmarks.Add Name:="prop_Key", Range :=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModel.Variables("PROP_ACCNUM").Delete 
35 docTCAModel.Variables.Add 'TROP_ACCNUM", "TCAVARNT" 
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docTCAModel.SaveAs tmpFName 
docTCAModel. Close 

End Sub 

Private Sub genCBT_MultChoice(udtClone As Clone, itaiKey As String) 
Dim docTCAModel As Document 

Set docTCAModel = mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

' MsgBox "CBT MultChoice" 

docTCAModel.Variables.Add "PROP_ACCNUM", "SSMCCBT" 
• mudtWord.WordApp.Run ("SetAccnum") 
mudtWord.WordApp.Run ("Startltem.Main") 

Dim tabchr As String 

tabchr = Chr(9) 

Dim destRange As Range 

Set destRange = docTCAModel.Content 

destRange. fmd.Execute FindText:=" Enter stem here." 

udtClone.CloneDoc.Bookmarks("tca_Stem").Range.Copy 
destRange.Paste 

destRange.Borders. Enable =^ False 

Dim respRange As Range 
Dim abcde As String 
abcde = "ABCDE" 
Dim i As Integer 

Set destRange = docTCAModel.Content 
destRange.find.Execute FindText:=" Enter responses here" 
destRange.End = destRange.End + 1 
destRange.Delete 

For i = 1 To 5 

Set respRange = udtClone.CloneDoc.Bookmarks("tca_Resp" & Mid(abcde, i, l)).Range 

respRange.start = respRange. start + 4 

respRange.Copy 

destRange.Paste 
destRange.Style = "Choice" 
destRange.InsertParagraphAfter 
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Set destRange = destRange.Paragraphs(l).Next.Range 
Next 

Dim key As String 

key = udtClone.CloneDoc.Bookmarks("tca_Key").Range.Text 
5 key = Mid(key, 8, 1) 

itmKey = key 

For i = 1 To 5 
If key = Mid(abcde, i, 1) Then 
key = FoiTnat(i) 
10 Exit For 

End If 
Next 

Dim keyRange As Range 
Dim keyStart As Long 
Set keyRange = docTCAModel.Content 
A keyStart = keyRange.End - 1 

m 

yi docTCAModel.Content.InsertAfter Text:=itmKey 

4« keyRange. SetRange start:=keyStart, End:=docTCAModel.Content.End 

^ ' docTCAModel.Bookmarks.Add Name:="prop_Key", Range :=keyRange 

2W Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 



docTCAModel.Variables("PROP_ACCNUM").Delete 
docTCAModel.Variables.Add "PROP_ACCNUM", "TCAVARNT" 
Call itemKey_Store(docTCAModel, udtClone.key) 
2£ docTCAModel.SaveAs tmpFName 

docTCAModel.Close 

End Sub 

Private Sub genPPT_QuantComp(udtClone As Clone, itmKey As String) 

Dim docTCAModel As Document 
30 Set docTCAModel = mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

' MsgBox "PPT QuantComp" 

docTCAModel.Variables.Add "PROP_ACCNUM", "QCPPT" 
' mudtWord.WordApp.Run ("SetAccnum") 
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mudtWord.WordApp.Run ("Startltem.Main") 

udtClone.CloneDoc.Bookmarks("tca_Stem").Range.Copy 
docTCAModel.Tables(l).Cell(Row:=l, Colunin:=2).Range.Paste 

docTCAModel.Tables(l).Cell(Row~l, Column:=2).Range.Style = "PPTQC StimCentered" 

udtClone.CloneDoc.Bookmarks("tca_ColumnA").Range.Copy 
docTCAModeLTables(l).Cell(Row:=2, Column:=2).Range.Paste 

udtClone.CloneDoc.Bookmarks(''tca_ColumnB")Range.Copy 
docTCAModel.Tables(l).Cell(Row:=2, Column:=4).Range.Paste 

docTCAModel.Tables(l).Cell(Row:=2, Column:-2).Range. Style = "PPTQC AB" 
docTCAModel.Tables(l).Cell(Row:=2, Column:-4).Range. Style = "PPTQC AB" 

Dim key As String 

key = udtCIone.CloneDoc.Bookmarks("tca_Key").Range.Text 
key = Mid(key, 8, 1) 
itmKey = key 

Dim abcde As String 
abcde = "ABCDE" 
Dim i As Integer 

For i = 1 To 5 
If key = Mid(abcde, i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

Dim keyRange As Range 

Dim keyStart As Long 

Set keyRange = docTCAModel. Content 

keyStart = keyRange.End - 1 

docTCAModel.Content.InsertAfter Text:=itmKey 
keyRange.SetRange start:=keyStart, End:=docTCAModel.Content.End 
• docTCAModelBookmarks.Add Name:="prop_Key", Range :=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModel.Variables("PROP_ACCNUM").Delete 
docTCAModel.Variables.Add "PROP_ACCNUM", "TCAVARNT" 
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docTCAModel.SaveAs tmpFName 
docTCAModel.Close 

End Sub 

Private Sub genCBT_QuantComp(udtClone As Clone, itmKey As String) 

5 Dim docTCAModel As Document 

Set docTCAModel = mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

* MsgBox "CBT QuantComp" 

docTCAModel.Variables.Add "PROP_ACCNUM", "QCCBT" 
' mudtWord.WordApp.Run ("SetAccnum") 
10 mudtWord.WordApp.Run C'Startltem.Main") 

udtClone.CloneDoc.Bookmarks("tca_Stem").Range.Copy 
docTCAModeLTables(l).Cell(Row:=l, Column:=l).Range.Paste 



i : : 



udtClone.CloneDoc.Bookmarks("tca_ColumnA").Range.Copy 
docTCAModel.Tables(l).Cell(Row:=2, Column:=l).Range.Paste 



1^" udtClone.CloneDoc.Bookmarks("tca_ColuninB").Range.Copy 
43 docTCAModel.Tables(l).Cell(Row:=2, Column:=2).Range.Paste 

^ Dim key As String 

key = udtClone.CloneDoc.Bookmarks(*'tca_Key").Range.Text 
CJ key = Mid(key, 8, 1) 
2d;f itmKey = key 

Dim abode As String 
g abode = "ABCDE" 
Dim i As Integer 

For i = 1 To 5 
25 If key = Mid(abcde, i, 1) Then 

key = Format(i) 
Exit For 
End If 
Next 

30 Dim keyRange As Range 

Dim keyStart As Long 
Set keyRange = docTCAModel.Content 
keyStart = keyRange.End - 1 

VBSCA-148- 



docTCAModel.Content.InsertAfter Text:=itmKey 
keyRange.SetRange start:=keyStart, End:=docTCAModel.Content.End 

* docTCAModel.Bookmarks.Add Name:="prop_Key", Range :=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModel.Variables("PROP_ACCNUM").Delete 
docTCAModel.Variables.Add 'TROP_ACCNUM", "TCAVARNT" 
Call iteniKey_Store(docTCAModel, udtClone.key) 
docTCAModel.SaveAs tmpFName 
docTCAModel. Close 

End Sub 

Private Sub genCBT_DataSuff(udtClone As Clone, itmKey As String) 
Dim docTCAModel As Document 

Set docTCAModel - mudtWord.WordApp.Documents.Open(App.path & "\TCAClone.DOC") 

' MsgBox "CBT DataSufr 

docTCAModel.Variables.Add "PROP^ACCNUM", "DSCBT" 
' mudtWord.WordApp.Run ("SetAccnum") 
mudtWord.WordApp.Run ("Startltem.Main") 

Dim tabchr As String 

tabchr = Chr(9) 

Dim destRange As Range 

Set destRange = docTCAModel.Content 

destRange. fmd.Execute FindText:="Enter stem here." 

udtClone.CloneDoc.Bookmarks("tcaStem").Range.Copy 
destRange.Paste 

* destRange.Borders.Enable = False 

' destRange.ParagraphFormat.Leftlndent = InchesToPoints(0.25) 
Set destRange ^ docTCAModel.Content 

destRange. fmd.Execute FindText:=="Enter Data Sufficiency Statement 1 here, then press 
return." 

' udtClone.CloneDoc.Bookmarks("tca_fStatement").Range.Copy 
Dim srcRange As Range 

Set srcRange = udtClone.CloneDoc.Bookmarks("tca_fStatement").Range 
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srcRange.End = srcRange.End - 1 
If Len(srcRange.Text) > 0 Then 

srcRange.Copy 

destRange.Paste 
End If 

destRange.Collapse Direction:=wdCollapseEnd 
destRange.InsertParagraphAfter 
destRange.Collapse Direction:=wdCollapseEnd 

Set srcRange = udtClone.CloneDoc.Bookmarks("tca_sStatement").Range 
srcRange.End = srcRange.End - 1 
If Len(srcRange.Text) > 0 Then 

srcRange.Copy 

destRange.Paste 
End If 

Dim n As Integer 

n = docTCAModel.ListParagraphs.Count 
While n > 2 

Set destRange = docTCAModel.ListParagraphs(n).Range 
destRange.Delete 
n = n - 1 
Wend 

Dim key As String 

key = udtClone.CloneDoc.Bookmarks("tca_Key").Range.Text 
key = Mid(key, 8, 1) 
itmKey = key 

Dim abcde As String 
abcde = "ABCDE" 
Dim i As Integer 

For i = 1 To 5 
If key = Mid(abcde, i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

Dim keyRange As Range 

Dim keyStart As Long 

Set keyRange = docTCAModel. Content 

keyStart = keyRange.End - 1 
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do cTC AModel . Content . Insert After Tex t : =i tmKey 
keyRange.SetRange start:=keyStart, End:=docTCAModel.Content.End 
' docTCAModel.Bookmarks.Add Name:="prop_Key'\ Range :=keyRange 

Dim tmpFName As String 

tmpFName = OUT_DIRECTORY & udtClone.FileName 

docTCAModel.VariablesCTROP_ACCNUM").Delete 
docTCAModel.Variables.Add "PROP_ACCNUM", "TCAVARNT" 
Call itemKey_Store(docTCAModel, udtClone.key) 
docTCAModel.SaveAs tmpFName 
docTCAModel. Close 

End Sub 

Private Sub itemKey_Store(doc As Document, ByVal key As String) 

Dim i As Integer 

For i = 1 To 5 
If key = Mid("ABCDE", i, 1) Then 
key = Format(i) 
Exit For 
End If 
Next 

doc.Variables.Add 'TtemKey Store", key 
End Sub 

Private Sub cmdPrintConstraints_Click() 

Dim udtV As Variable 
Dim udtC As Constraint 
Dim udtVI As Varlnteger 
Dim udtVR As VarReal 
Dim udtVF As VarFraction 
Dim udtVS As VarString 
Dim udtP As New PrintModel 
Dim varS As Variant 
Dim varSl As Variant 
Dim udtSS As Substring 
Dim inti As Integer 

udtP.ModelName = ExtractFileNameNoExt(mudtFam.ActiveModel.FileName) 
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Call udtP.PrintStringC'Variables:", 1) 



For Each udtV In mudtFam.ActiveModel.Variables 

Call udtP.PrintStringC'Variable name: " & udtV.name, 2) 
Select Case udtV.Typ 
Case vtlnteger 

Call udtP.PrintStringC'Type: Integer", 3) 
Case vtReal 

Call UdtP.PrintStringC'Type: Real", 3) 
Case vtFraction 

Call udtP.PrintString("Type: Fraction", 3) 
Case vtString 

Call udtP.PrintString("Type: String", 3) 
Case vtUntyped 

Call udtP.PrintString("Type: Untyped", 3) 
End Select 

IfudtV.EnabledThen 

Call udtP.PrintString("Status: Enabled", 3) 
Else 

Call udtP.PrintString("Status: Disabled", 3) 
End If 

If udtV. Checksum Then 

Call udtP.PrintString("Checksum: Enabled", 3) 
Else 

Call udtP.PrintString("Checksum: Disabled", 3) 
End If 

Select Case udtV.Typ 
Case vtlnteger 
SetudtVI = udtV 
If udtVI.IsIndependent Then 

Call udtP.PrintString("Is independent = True," «& . 
" Range: from " & udtVI.From & _ 
" to " & udtVI.Too & _ 
" by " & udtVI.By, 3) 

Else 

Call udtP.PrintString("Is independent = False", 3) 
End If 
Case VtReal 

Set udtVR = udtV 

If udtVR.IsIndependent Then 

Call udtP.PrintString("Is independent = True," & . 
" Range: from " & udtVR.From & _ 
" to " & udtVRToo & _ 
" by " & udtVR.By, 3) 
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Else 

Call udtP.PrintString("Is independent = False", 3) 
End If 

If udtVRJsOnGrid Then 

Call udtP.PrintStringC'Force on grid value: True", 3) 
Else 

Call udtP.PrintString("Force on grid value: False", 3) 
End If 

Call udtP.PrintString("# Decimal places: " & _ 

Str(udtVR.DecimalPlaces), 3) 
If udtVR.TrailingZeros Then 

Call udtP.PrintString("Display traiUng zeros: True", 3) 
Else 

Call udtP.PrintString("Display trailing zeros: False", 3) 
End If 
Case vtFraction 
SetudtVF = udtV 
If udtVF.IsIndependent Then 
Call udtP.PrintString("Is independent = True," & _ 
" Range: from " & udtVF.FromNumerator & _ 
"/" & udtVF.FromDenominator & _ 
" to " 8c udtVF.ToNumerator & _ 
"/" & udtVF.ToDenominator & _ 
" by " & udtVF.ByNumerator & _ 
"/" & udtVF.ByDenominator, 3) 

Else 

Call udtP.PrintString("Is independent = False", 3) 
End If 

If udtVF.MixedNumbers Then 

Call udtP.PrintString("Display mixed number: True", 3) 
Else 

Call udtP.PrintString("Display mixed number: False", 3) 
End If 
Case vtString 
Set udtVS = udtV 
If udtVS.IsIndexed Then 

Call udtP.PrintString("Indexed: True", 3) 
Call udtP.PrintString("Value Sets:", 3) 
For Each varS In udtVS.StringCoUection 
Set udtSS = New Substring 
udtSS.Delimiter = Chr(STRING_DELIMITER) 
udtSS.StringValue = varS 
Call udtP.PrintStringC'Values:", 4) 
inti = 1 

For Each varSl In udtSS.StringCoUection 
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Call udtP.PrintString(Str(intI) & " & varSl, 5) 
inti = inti + 1 
Next varSl 
Next varS 
Else 

Call udtP.PrintStringC'Indexed: False", 3) 

Call udtP.PrintStringC'Values:", 3) 

For Each varS In udtVS.StringCoUection 

Call udtP.PrintString(varS, 4) 
Next varS 
End If 
Case vtUntyped 
End Select 

Next udtV 

Call udtP.PrintString("Constraints:", 1) 

Call udtP.PrintString("Variation constraints:", 2) 

For Each udtC In mudtFam.ActiveModel.Constraints 
If udtC.ConstraintType = ctVariation Then 
Call udtP.PrintString("Constraint: " & udtC.ConstraintString, 3) 
IfudtC.EnabledThen 

Call udtP.PrintString("Status: Enabled", 4) 
Else 

Call udtP.PrintString("Status: Disabled", 4) 
End If 
End If 
Next udtC 

'exit if not MC 

If Not mudtFam.ItemType = ptStandardMC Then Exit Sub 

Call udtP.PrintString("Distractor constraints:", 2) 

For Each udtC In mudtFam.ActiveModel.Constraints 
If udtC.ConstraintType = ctDistractor Then 
Call udtP.PrintString("Constraint: " & udtC.ConstraintString, 3) 
IfudtC.Enabled Then 

Call udtP.PrintString("Status: Enabled", 4) 
Else 

Call udtP.PrintString("Status: Disabled", 4) 
End If 
End If 
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Next udtC 
End Sub 

Private Sub cmdSetAttributes_Click() 
frmAttributes.Show vbModal 

If frmAttributes.OK Then 

mudtF am. Generic = frm Attributes. Generic 

mudtFam.Proximity = frmAttributes.Proximity 

mudtFam.IsDirty = Trae 

' save family 

mudtFam.WritePamily 

UpdateFamilyAttributes 
End If 

End Sub 

Private Sub cmdTreeExtend_Click() 

Call mnuTreeExtend_Click 
End Sub 

Private Sub cmdTreeRemove_Click() 

Call mnuTreeRemove_Click 
End Sub 

Private Sub cmdVariableAdd_Click() 

Call mnuVariablesAdd_Click 
frmVariable.Model = mudtF am. ActiveModel 
frmVariable.ListBox = IstVariables 

frm Variable. Show vbModal 

UpdateTab 1 ControlStates 

End Sub 

Private Sub cmdVariableEdit_Click() 
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Call mnuVariablesEdit_Click 
frmVariable.Model = mudtFam. ActiveModel 
frmVariable.ListBox = IstVariables 

If IstVariables.Listlndex >= 0 Then ' Make sure list item is selected 
' Set the key for access by frmVariable 
With IstVariables 

frmVariable. Variable = _ 

mudtFam.ActiveModeLVariables.Item(Str(.ItemData(.ListIndex))) 
End With 

frmVariable. Show vbModal 
End If 

UpdateTab 1 ControlStates 
End Sub 

Private Sub cmdVariableRemove_Click() 

Call mnuVariablesRemove__Click 
End Sub 

Private Sub cmdVariableTest_Click() 

Call mnuVariablesTest_Click 
End Sub 

Private Sub Form_Initialize() 

frmSplash.Shov^ 
End Sub 

Private Sub Form_Load() 

' to trap cancels 
cdlCD.CancelError = True 

'Create Word Object 

Set mudtWord = New MSWord 

' get rid of the kill file if it exists, as it will prevent 
' StartProlog from working 
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DestroyKillFile 



' Create the Prolog object 

If mudtProlog Is Nothing Then 

Set mudtProlog = CreateObject("AXProlog.Prolog") 

If Not mudtProlog. StartProlog Then 

Call MsgBox("Prolog cannot be started.", vbExclamation, "Prolog error") 

End If 
End If 

treModels.ImageList = imll 
frmSplash.UnloadMe 
Me. Show 

UpdateTabOControlStates 

' * copies ied files from a holding area, as TCS deletes them for 

' ' reasons unknown. 

' Call Kill("c:\tcs\working\*.ied") 

' Call FileCopy("c:\tcs\tcaied\dscbt.ied", "c:\tcs\working\dscbt.ied") 

' Call Shell("attrib -r c:\tcs\working\dscbt.ied", vbHide) 

• CallFileCopy("c:\tcs\tcaied\qccbt.ied", "c:\tcs\working\qccbt.ied") 

' Call FileCopy("c:\tcs\tcaied\qcppt.ied", "c:\tcs\working\qcppt.ied") 

' Call FileCopy("c:\tcs\tcaied\ssmccbt.ied", "c:\tcs\working\ssmccbt.ied") 

' Call FileCopy("c:\tcs\tcaied\ssmcppt.ied", "c:\tcs\working\ssmcppt.ied") 

End Sub 

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 

Call sstMainTab_MouseMove(Button, Shift, X, Y) 
End Sub 

Private Sub Form_Resize() 
' if minimized, don't resize 

If Me.WindowState = vbMinimized Then Exit Sub 

Dim udtW As New Win32API 
Dim result As Long 

Tum off fiiU window drag if it's on 
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If udtW.IsFuU WindowDragOn Then 

udtW.TumOffFuUWindowDrag 

mblnRestoreFuUWindowDrag = True 
End If 

5 ' adjust horizontals 

fraWord.left=120 

fraWord. Width = Me. Width - sstMainTab.Width - 360 
sstMainTab.left = fraWord. Width + 180 

'adjust verticals 

10 fraWord.Height = Me.Height - fraWord. top - stbS. Height - 700 ' approx title bar height 

sstMainTab.Height = fraWord.Height 

mudtWord.Resize 

End Sub 

1 |j Private Sub Form_Unload(Cancel As Integer) 

yl ' if no active family, hit the road 

Ul If mudtFam Is Nothing Then 

42 ' do nothing 

f Else 
26: mudtFam. WriteFamily 

If mudtFam.ActiveModel Is Nothing Then ' see if an active model has been set 

' do nothing 
Else 

mudtFam.ActiveModel.CloseDoc 
2^1 KillVariants * Get rid of any variants left on tab 3 

f i mudtFam.ActiveModel.WriteModel ' save the active model 

5 End If 

End If 

' close all docs 
30 mudtWord.CloseAUDocs 

' Kill Word before frmTCA is unloaded to prevent automation error 
Set mudtWord = Nothing 

' force event 

Call sstMainTab_MouseMove(l, 1, 1, 1) 



35 



' To cleanly shut down AXProlog on W95, 98 boxes 
mudtProlog.EndProlog 
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' End required by NT 4.0 to shut down TCA successfully! 
End 

End Sub 

Private Sub lstVariables_ItemCheck(Item As Integer) 

With IstVariables 

If IstVariables.ListCount == 0 Then Exit Sub ' this prevents an error 
If mudtFam.ActiveModel.IsFrozen Then 
.Selected(Item) = _ 
mudtFam.ActiveModel.Variables.Item(Str(.IteniData(Item))).Enabled 

Else 

niudtFani ActiveModel.Variables.Item(Str(.IteraData(Iteni))).Enabled = _ 
.Selected(Item) 
End If 
End With 

UpdateTab 1 ControlStates 
End Sub 

Private Sub lstVariables_MouseDown(Button As Integer, Shift As Integer, _ 
X As Single, Y As Single) 

Dim strlndex As String 

Set mlstCurrentListBox = IstVariables 

If Button = vbRightButton Then 

frmVariable.AddEditFlag = aeNothing 

PopupMenu mnuVariables * Pull up popup menu for variable windov^ 
frmVariable.Model = mudtFam.ActiveModel 
fhnVariable.ListBox = IstVariables 
Select Case frmVariable.AddEditFlag 
Case aeEdit 

If IstVariables. Listlndex >= 0 Then ' Make sure list item is selected 
* Set the key for access by fhnVariable 
With IstVariables 

fhnVariable.Variable = _ 

mudtFam.ActiveModeLVariables.Item(Str(.ItemData(.ListIndex))) 

End With 

fhnVariable. Show vbModal 
End If 
Case aeAdd 
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frmVariable.Show vbModal 
End Select 
End If 

End Sub 

Private Sub lstConstraints_ItemCheck(index As Integer, Item As Integer) 

Dim strKey As String 

With IstConstraints(index) 

If .ListCount = 0 Then Exit Sub * prevents error if hstbox is empty 
If mudtFam.ActiveModel.IsFrozen Then 
.Selected(Item) = _ 
mudtFam.ActiveModel.Constraints.Item(Str(.ItemData(Item))).Enabled 

Else 

mudtFam.ActiveModel.Constraints.Item(Str(.ItemData(Item))).Enabled = 
.Selected(Item) 
End If 
End With 

UpdateTab 1 ControlStates 
End Sub 

' provide right button menu options 

Private Sub lstConstraints_MouseDown(index As Integer, Button As Integer, _ 
Shift As Integer, X As Single, Y As Single) 

Dim strlndex As String 

Set mlstCurrentListBox = IstConstraints(index) 
mintConstrLBInd = index 

Call UpdateTab 1 ControlStates(index) 

If Button = vbRightButton Then 

PopupMenu mnuConstraints 
Else 

If mudtFam.ActiveModel.IsFrozen = False Then 

IstConstraints(index) .Drag 
End If 
End If 

End Sub 
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' Enable drag and drop between constraint list boxes 

Private Sub lstConstraints_DragDrop(index As Integer, Source As Control, _ 
X As Single, Y As Single) 

If Source.ListCount = 0 Then 

Exit Sub 
End If 

If index o Source. index Then ' Assure that it's another listbox! 

Dim udtConstraint As Constraint 
Dim strKey As String 

strKey = Str(Source.ItemData(Source.ListIndex)) 

With IstConstraints(index) 

' Add the dragged constraint to the end of the target listbox 

.List(.ListCount) = Source.List(Source.Listlndex) 

' Update the index in the new listbox entry 

.IteniData(.ListCount - 1) = Source.ItemData(Source.Listlndex) 
End With 

' Find the constraint object being moved and update if s "type" in the collection 
Set udtConstraint = mudtFam. ActiveModel.Constraints.Item(strKey) 
udtConstraint. ConstraintType = index 

' Delete the dragged constraint from the source listbox 
Call Source. Removeltem(Source.Listlndex) 

End If 

UpdateTab 1 ControlStates 
End Sub 

Private Sub lstDisposition_MouseDown(Button As Integer, Shift As Integer, _ 
X As Single, Y As Single) 

Dim udtClone As Clone 

If Button - vbRightButton Then 

PopupMenu mnuDisp 
Else 

With IstDisposition 

If .ListCount > 0 Then ' a valid selection has been made 
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Set udtClone = mudtFam.ActiveModel.Clones.Item(Str(.ItemData(.ListIndex))) 
Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
End If 
End With 
End If 
End Sub 

Private Sub lstAccepted_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As 
Single) 

Static udtClone As Clone 

If Button = vbRightButton Then 
With IstAccepted 
If .SelCount= 1 Then 
' mnuAcceptedProfile.Enabled = True 

' mnuAcceptedCopy.Enabled = True 

' Set udtClone = mudtFam.Clones.Item(Str(.ItemData(.ListIndex))) 

Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
' Set udtClone = Nothing 

' Else 

' mnuAcceptedProfile.Enabled = False 

' mnuAcceptedCopy.Enabled = False 

End If 
End With 

PopupMenu mnuAccepted 
Else ' left button click 
If udtClone Is Nothing Then 

' do nothing 
Else 

udtClone.CloseDoc 
Set udtClone = Nothing 
End If 

With IstAccepted 

If .ListCount>OThen 

Set udtClone = mudtFam.Clones.Item(Str(.ItemData(.ListIndex))) 
Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
End If 
End With 
End If 

UpdateTabOControlStates 
End Sub 
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Private Sub cmdSaveModel_Click() 

If mudtFam.ActiveModel.IsDirty Then 
mudtFam.ActiveModel.WriteModel 
KillVariants 'delete any variants on tab 3 
5 End If 

UpdateTab 1 ControlStates 

End Sub 

Private Sub cmdTestAll_Click() 

cmdSaveModel_Click ' force a save 
1 0 Call TestConstraints(tcTestAll) 

End Sub 

f=n Private Sub cmdImportConstraints_Click() 

gi Dim strFN As String 

Ul 

^ With cdlCD 
W .FileName = "" 

4^ .CancelError = True 

.DialogTitle = "Import constraints from file" 
.Filter = "Constraint Files (*.con)|*.conr' 

% .DefaultExt = ".con" 

2p? .InitDir = "c:\tcs\tca\constraints" 

ti .Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 

H On Error GoTo Cancel ' trap the Cancel button 

.ShowOpen 

On Error GoTo 0 ' reset the error 
25 StrFN = .FileName 

End With 

' exit if there's no file name 

If Len(strFN) = 0 Then 
Exit Sub 
30 End If 

' create a new collection of imported variables 

Dim udtCVariables As New CVariables 
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Call udtCVariables.ReadCollection(strFN, crVariablelndex, crConstraintlndex) 

' add the imported variables to the main collection 

Dim udtNewVar As Variable 

For Each udtNewVar In udtCVariables 

If mudtFam.ActiveModel.Variables.UniqueName(udtNewVar.name) Then 
Call mudtFam. ActiveModel. Variables. AddObject(udtNewVar) 
With IstVariables 

' Add the new variable to the variable list box 
Call .Addltem(udtNewVar.ScreenFormat) 
' Set ItemData to index value of the variable object 
.ItemData(.ListCount - 1) = udtNewVar.index 

* Set the check box. 

.Selected(.ListCount - 1) = udtNewVar.Enabled 
End With 
Else 

Call MsgBox("Variable " & udtNewVar.name & " will not be imported.", _ 
vbExclamation, "Variable not unique") 
End If 

Next udtNewVar 

' read the imported constraints into a new collection 
Dim udtCConstraints As New CConstraints 

Call udtCConstraints.ReadCollection(strFN, crConstraintlndex, READ_UNTIL_EOF) 

' add the imported constraints 

Dim udtNewCon As Constraint 

For Each udtNewCon In udtCConstraints 

If mudtFam.ActiveModel.Constraints.UniqueConstraint(udtNewCon.ConstraintString) 
Then 

Call mudtFam.ActiveModel.Constraints.AddObject(udtNewCon) 
With IstConstraints(udtNewCon.ConstraintType) 

* Add the new variable to the variable list box 
Call .Addltem(udtNewCon.ConstraintString) 

' Set ItemData to index value of the variable object 
.IteniData(.ListCount - 1) = udtNewCon.index 

* Check the check box 

.Selected(.ListCount - 1) = udtNewCon.Enabled 
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End With 
Else 

Call MsgBox("Constraint " & udtNewCon.ConstraintString & " will not be imported." 
vbExclamation, "Constraint not unique") 
End If 
Next udtNewCon 

Cancel: 
Exit Sub 

End Sub 

Private Sub cmdExportConstraints_Click() 

Dim strFN As String 

With cdlCD 
.FileName = "" 

.DialogTitle = "Export constraints to file" 
.Filter = "Constraint Files (*.con)|*.con|" 
.DefaultExt = ".con" 
.InitDir = "c:\tcs\tca\constraints" 

.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly 
On Error GoTo Cancel * trap the Cancel button 
.ShowSave 

On Error GoTo 0 ' reset 
StrFN = .FileName 
End With 

Dim IngEndPos As Long 

IfLen(strFN)>OThen 

IngEndPos = mudtFam. ActiveModel.Variables.WriteCollection(strFN, crVariablelndex, 
crVariables) 

Call mudtFam.ActiveModeLConstraints.WriteCollection( StrFN, crConstraintlndex, 
IngEndPos) 
End If 

Cancel: 
Exit Sub 

End Sub 

Private Sub cmdPrintBatch_Click() 
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Dim blnTF As Boolean 
Dim udtClone As Clone 

If mudtWord.WordApp.Documents.Count = 0 Then 

mudtWord.WordApp.Documents.Open FileName:=App.path & "\printing.doc" 

blnTF = True 
End If 

For Each udtClone In mudtFam.Clones 

mudtWord.WordApp.PrintOut FileName:=IN_DIRECTORY & udtClone.FileName 
Next udtClone 

If blnTF Then 

mudtWord.WordApp.Documents. Close 
End If 

End Sub 

Private Sub cmdPrintVariants_Click() 

Dim blnTF As Boolean 
Dim udtClone As Clone 

If mudtWord.WordApp.Documents. Count = 0 Then 

mudtWord.WordApp.Documents.Open FileName:=App.path & "\printing.doc" 

blnTF = True 
End If 

For Each udtClone In mudtFam. ActiveModel.Clones 

mudtWord.WordApp.PrintOut FileName:=IN_DIRECTORY & udtClone.FileName 
Next 

If blnTF Then 

mudtWord.WordApp.Documents. Close 
End If 

End Sub 

Private Sub cmdGenerate_Click() 
Dim udtClone As New Clone 

Me.Enabled = False ' disable frmTCA to make next form seem modal 
fhnProlog.Caption = "Generating " & txtNum2 Generate & " variants" 
frmProlog.lblProlog. Caption = "Click Abort to terminate variant generation." 
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frmProlog.Show * show form modeless so execution continues 
Me.MousePointer = vbHourglass 

Call mudtFam. ActiveModel.GenerateCiones(mudtWord, mudtProlog, _ 

CInt(txtNum2Generate), sldDifference) 
Me.MousePointer = vbDefault 
frmProlog.Kill ' destroy frmProlog 
Me.Enabled = True 

If IstDisposition.ListCount > 0 Then 
With IstDisposition 

.Selected(.ListCount - 1) = True 

Set udtClone = mudtFam. ActiveModel.Clones.Item(Str(.ItemData(.ListCount - 1))) 
Call udtClone.OpenDoc(mudtWord, IN_DIRECTORY) 
End With 
End If 

UpdateTab2ControlStates 
End Sub 

Private Sub mnuDispAccept_Click() 

Dim udtClone As Clone 
Dim nodN As Node 
Dim inti As Integer 
Dim strFN As String 

With IstDisposition 

If .SelCount > 0 Then ' make sure something's selected 
For intI = 0 To .ListCount - r for multiselect 
If .Selected(intl) Then 
StrFN = 

ExtractFileName(mudtFam.ActiveModel.Clones.Item(Str(lstDisposition.ItemData(intI))).FileNa 
me) 

' confirm this operation 

If MsgBox(" Accept variant " & strFN & "?", _ 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
.Selected(intl) = False 
End If 
End If 

If .Selected(intl) Then 

' get object from active model's clone collection 

Set udtClone = mudtFam.ActiveModel.Clones.Item(Str(.ItemData(intI))) 
' close the document, if it's open 
udtClone. CloseDoc 
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' remove it from the active moders collection 

Call mudtFam.ActiveModel.Clones.Remove(Str(.ItemData(intI))) 

* save the checksum in the model 

Call mudtFam.ActiveModel.AddChecksum(udtClone.Checksum) 
5 * add it to the family clone collection 

Call mudtFam.Clones.AddObj(udtClone) 

* add it to the accepted list box 

Call lstAccepted.AddItem(ExtractFileName(udtClone.FileName)) 
' add key to itemdata 

10 lstAccepted.ItemData(lstAccepted.ListCount - 1) = udtClone.index 

* freeze the model 

mudtFam . Ac t i veMo del . FreezeModel 

* update the icon 

Set nodN = treModels.Nodes.Item(ModelKey(mudtFam.ActiveModel.FileName)) 
1 5 nodN.Image = imSnowflake 

stbS.Panels(pnActiveModelIcon).Picture = imlI.ListImages(nodN.Image).Picture 
Call mudtFam.ActiveModel.CloseDoc 
Call mudtFam.ActiveModeLOpenDoc(mudtWord) 
End If 

2Q] Next inti 

m For intI = .ListCount - 1 To 0 Step -1 

yi If .Selected(intI)Then 

' remove the entry from the disposition list box 
Call .Removeltem(intl) 
2^5 End If 

^ Next intI 

L End If 

% End With 

K UpdateTabOControlStates 
3|] UpdateTab 1 ControlStates 

n UpdateTab2ControlStates 

End Sub 

Private Sub mnuDispDefer_Click() 

Dim udtClone As Clone 
35 Dim intI As Integer 

Dim strFN As String 

With IstDisposition 

If .SelCount > 0 Then ' make sure somethings selected 
For intI = 0 To .ListCount - 1* for multiselect 
40 If .Selected(intI)Then 
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strFN = 

ExtractFileName(mudtFamActiveModel.ClonesJtem(Str(lstDispositionJternData(in^ 
me) 

' confirm this operation 

If MsgBox("Defer variant " & strFN & _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

.S elect ed(intl) = False 
End If 
End If 

If .Selected(intl) Then 

' get object from active model's clone collection 

Set udtClone = mudtFam.ActiveModel.Clones.Item(Str(.ItemData(intI))) 
' close the document 
udtClone.CloseDoc 
' delete the clone file 

Kill IN DIRECTORY & udtClone.FileName 
' remove the clone from the active model's collection 
Call mudtFam.ActiveModel.Clones.Remove(Str(.IteniData(intI))) 
End If 
Next inti 

For intI = .ListCount - 1 To 0 Step -1 'for multiselect 
If .Selected(intl) Then 

' remove the entry from the disposition list box 
Call .Removeltem(intl) 
End If 
Next intI 
End If 
End With 

UpdateTab2ControlStates 
End Sub 

Private Sub mnuDispDiscard_Click() 

Dim udtClone As Clone 
Dim intI As Integer 
Dim StrFN As String 

With IstDisposition 

If .SelCount > 0 Then ' make sure somethings selected 
For intI = 0 To .ListCount - 1 ' for multiselect 
If .Selected(intl) Then 
StrFN = 

ExtractFileName(mudtFam.ActiveModel.Clones.Item(Str(lstDisposition.ItemData(intI))).FileNa 
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' confirm this operation 

If MsgBoxC'Discard variant " & strFN & "?", _ 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
.Selected(intl) = False 

End If 
End If 

If .Selected(intl) Then 

* get object fi*om active model's clone collection 

Set udtClone = mudtFam.ActiveModel.Clones.Item(Str(.IteniData(intI))) 
' save the checksum in the model 

Call mudtFam.ActiveModel.AddChecksum(udtClone.Checksum) 
i * close the document 
udtClone.CloseDoc 

* delete the clone file 

Kill IN_DIRECTORY & udtClone.FileName 

* remove the clone fi"om the active model's collection 

Call mudtFam.ActiveModel.Clones.Remove(Str(.ItemData(intI))) 
End If 
Next inti 

For intI = .ListCount - 1 To 0 Step -1 ' for multiselect 
If .Selected(intl) Then 

' remove the entry from the disposition list box 
Call .Removeltem(intl) 
End If 
Next intI 
End If 
End With 

UpdateTab2ControlStates 
End Sub 

Private Sub mnuDispMakeModel_Click() 

Dim udtClone As Clone 
Dim strNewFN As String 
Dim strKey As String 
Dim strNewKey As String 
Dim udtM As Model 
Dim nodN As Node 
Dim intI As Integer 
Dim StrFN As String 

With IstDisposition 
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If .SelCount > 0 Then ' make sure somethings selected 
For inti = 0 To .ListCount - 1 * for multiselect 
If .Selected(intl) Then 
strFN = 

ExtractFileName(mudtFam.ActiveModeLClones.Item(Str(lstDisposition.ItemData(intI))).FileNa 
me) 

* confirm this operation 

If MsgBox("Create a new model from variant " & strFN & "?", _ 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
.Selected(intl) = False 
End If 
End If 

If .Selected(intl) Then 

' get object from active modeFs clone collection 

Set udtClone = mudtFam.ActiveModel.Clones.Item(Str(.ItemData(intI))) 

* close the document 
udtClone.CloseDoc 

strKey = ModelKey(udtClone.FileName) 
' find the next key for this parent model 
strNev^Key = NextModelKey(udtClone.FileName) 
' add the child to the tree 

strNev^FN = ModelEmbedKey(udtClone.FileName, strNewKey) 

Set nodN = treModels.Nodes.Add(strKey, tvwChild, strNewKey, strNewFN) 

nodN.Expanded = True 

nodN. sorted = True 

nodN.Image = imSun 

* copy the clone to the new model file name 

Call FileCopy(IN__DIRECTORY & udtClone.FileName, IN_DIRECTORY & 

StrNewFN) 

' make a copy of the parent's model file for this child 
Call FileCopy(ModelFileName(IN_DIRECTORY & 
ModelEmbedKey(udtClone.FileName, strKey)), _ 

ModelFileName(IN_DIRECTORY & strNewFN)) 
' add the child's model to the model collection. "Thaw" the child. 
Set udtM - mudtFam.Models. AddExisting(IN_DIRECTORY & strNewFN, _ 

mudtFam.ItemType) 
udtM.IsFrozen = False 
' reset the clone index of the child 
udtM.LastClone = 0 
' save it 

udtM.WriteModel 

* tell 'em about it 

Call MsgBox(" Variant " & udtClone.FileName & " has been copied to " & 
StrNewFN, _ 

vblnformation, "Model Created") 
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End If 
Next inti 
End If 
End With 

5 UpdateTabOControlStates 
UpdateTab2ControlStates 

End Sub 

Private Sub mnuFileNew_Click() 

Dim udtWAPI As New Win32API 
10 Dim strFN As String 

Dim udtProgram As Program 

Dim udtltemType As ItemType 

Dim udtProximity As Proximity 

Dim blnGeneric As Boolean 
1 Dim udtini As New IniFile 

01 * clear out everything 

yi ClearControls 

™- 

4j ' get family values (pun intended) 

frmNew.Show vbModal 
^ If frmNew.OK = False Then GoTo Cancel 

udtProgram = frmNew.Program 
2? udtltemType = frmNew.ItemType 

n udtProximity = fhnNew.Proximity 

2^^; blnGeneric = frmNew.Generic 

With cdlCD 

.InitDir = IN_DIRECTORY 
.FileName - 

.DialogTitle "Save new family as" 
30 .Filter = "Model Doc Files (*$R.doc)|*$R.docr 

.DefaultExt = ".doc" 

.Flags = cdlOFNHideReadOnly 

On Error GoTo Cancel 

.ShowSave 
35 On Error GoTo 0 

StrFN = .FileName 
End With 
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' see if an FN was entered 
IfLen(strFN) = OThen 
Beep 

GoTo Cancel 
End If 

strFN = UCase(strFN) 

' don't allow family to be created if it's not in the "IN" directory 
If InStr(l, StrFN, IN_DIRECTORY, vbTextCompare) Then 

' do nothing 
Else 

Call MsgBoxC'Family must be located in " & IN_DIRECTORY, _ 

vbExclamation, "Error") 
GoTo Cancel 
End If 

' check the extension 

If (InStr(l, StrFN, ".doc", vbTextCompare)) = 0 Then 

Call MsgBox("Invalid file name extension.", vbExclamation, "Error") 

GoTo Cancel 
End If 

Dim varl As Variant 

' embed $R into FN if the user hasn't 

If InStr(l , StrFN, "SR.doc", vbTextCompare) = 0 Then 

varl = InStr(l, strFN, ".doc", vbTextCompare) 

StrFN = Mid(strFN, 1, varl - 1) «& "$R.doc" 
End If 

' check for unique FN 
If udtWAPI.FileExists(strFN) Then 
Call MsgBox("File name " & _ 

ExtractFileName(strFN) & " is not unique.", _ 
vbExclamation, "Error") 
GoTo Cancel 
End If 

Dim strShortFN As String 
strShortFN = ExtractFileName(strFN) 

' create a new family object 
Set mudtFam = New Family 
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' set file name, program, and item type 
mudtFam.FileName = strFN 
mudtFam.Program = udtProgram 
mudtFam.ItemType = udtltemType 
5 mudtFam.Proximity = udtProximity 

mudtFam.Generic = blnGeneric 
mudtFam.IsDirty = True 

' put the family name on the status bar 
stbS.Panels(pnFamilyName) = strShortFN 

10 'fill in the rest of the status bar 

UpdateFamilyAttributes 

' format tab 2 

Call FormatTab2(mudtFam .ItemType) 

' copy correct Word template to new model FN 
1 Select Case mudtFam.ItemType 

m Case ptStandardMC 

ui FileCopy App.path & "\TCASMC.doc", strFN 



Case ptQuantComp 
FileCopy App.path & "\TCAQC.doc", strFN 



26. Case ptDataSuff 

5 FileCopy App.path & "\TCADS.doc", strFN 



a 



End Select 

Dim nodN As Node 



* clear out the treeview box 
25 treModels.Nodes. Clear 

' add the new root 

Set nodN = treModels.Nodes.Add(, , "R", strShortFN, imSun) 
nodN.Expanded = True 
nodN. sorted = True 
30 nodN.Selected = True 

Call mudtFam.Models.AddNew(strFN, mudtFam.ItemType) 

' enable attributes button 
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cmdSetAttributes.Enabled = True 

' force event to set active model 
treModels_Click 

Cancel: 

UpdateTabOControlStates 

Exit Sub 
End Sub 

Private Sub mnuFileOpen ClickQ 

Dim strFN As String 

' clear out everything 
ClearControls 

With cdlCD 

.InitDir = IN_DIRECTORY 

.FileName = "" 

.CancelError = True 

.DialogTitle = "Open model root" 

.Filter = "Model Doc Files (*$R.doc)|*$R.doc|" 

.DefaultExt = ".doc" 

.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowOpen 
On Error GoTo 0 
StrFN = .FileName 
End With 

' exit if there's no file name 
IfLen(strFN) = OThen 

Exit Sub 
End If 

StrFN = UCase(strFN) 

' don't allow family to be opened if it's not in the "IN" directory 
If InStr(l, StrFN, IN DIRECTORY, vbTextCompare) Then 

' do nothing 
Else 
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Call MsgBoxC'Family must be located in " & IN_DIRECTORY, 

vbExclamation, "Error") 
Exit Sub 
End If 

' find all of the children 

Dim nodN As Node 

Dim strlndex As String 

Dim strT As String 

Dim varll As Variant 

Dim udtWAPI As New Win32API 

Dim strNewFN As String 

Dim colFN As Collection 

* add a wild card to the file name 
varll =InStr(l,strFN, ".") 

StrNewFN - Mid(strFN, 1, varll - 1) & "*" & Mid(strFN, varll, _ 
Len(strFN) - varll + 1) 

' get a collection of file names (*.doc) matching the wild card 
Set colFN = udtWAPLFindAllFiles(strNewFN) 

* create a new family object 
Set mudtFam = New Family 

Dim strMdfFN As String 

' make sure the .mdf file is there. 
StrMdfFN = left(strFN, Len(strFN) - 3) & "mdf* 
If udtWAPLFileExists(strMdfFN) = False Then 
Call MsgBox("This family has a " & _ 

"missing mdf file and cannot be loaded. " & _ 
"File " & StrMdfFN & " is not in the IN directory.", _ 
vbExclamation, "Error") 
Exit Sub 
End If 

' set the file name of the family, read. 
mudtFam.FileName = strFN 
mudtFam.ReadFamily 

Dim udtClone As Clone 

' verify that all variants referenced in the family object are in 
' the IN directory. 
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For Each udtClone In mudtFam.Clones 

' the next Hne allows families to be renamed between TCA sessions 
# udtClone.FileName = ExtractFamilyName(strFN) & _ 

t ExtractFamilyKey(udtClone.FileName) & " .doc" 

5 If udtWAPLFileExists(IN_DIRECTORY & udtClone.FileName) = False Then 

Call MsgBox('This family has at least " & _ 

"one missing variant file and cannot be loaded. " & _ 
^ "File " & udtClone.FileName & " is not in the IN directory.", _ 

vbExclamation, "Error") 
10 Exit Sub 

End If 
Next udtClone 

' put family name on status bar 

stbS.Panels(pnFamilyName) = ExtractFileName(strFN) 



15 'format tab 2 

Call FormatTab2(mudtFam.ItemType) 

% ' update the accepted listbox with leftover clones 

m For Each udtClone In mudtFam.Clones 

yi With IstAccepted 

2Qf If udtClone.IsRouted Then 

h Call .AddItem(udtClone.FileName & ": Routed to TCS") 

4« Else 

JJ Call .Addltem(udtClone.FileName) 

L End If 

2§;f .ItemData(.ListCount - 1) = udtClone.index 

I j End With 

h' Next udtClone 



' select the first entry, if there is one 
If IstAccepted.ListCount > 0 Then 
30 IstAccepted.Selected(O) = True 

End If 

' display attribute info on status bar 
UpdateFamily Attributes 

' clear out the dummy list box 
35 Call IstDummy.Clear 

Dim varFN As Variant 
Dim udtM As Model 
Dim inti As Integer 
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Dim intlcon As Integer 



' dump the file names into a dummy list box which will sort them automatically. 
' the tree control must add them in heirarchical order. 

For Each varFN In colFN 
varll =InStr(l, varFN, ".") 

If IsNumeric(Mid(varFN, varll -1,1)) = False Then ' it's not a clone 

Call IstDummy.Addltem(varFN) ' add the model 
End If 
Next varFN 

Dim strMdlFN As String 

For inti = 0 To IstDummy.ListCount - 1 

varFN = lstDummy,List(intI) 
strlndex = ModelKey(varFN) 
If UCase(strlndex) = "R" Then 

Set nodN = treModels.Nodes. Add(, , strlndex, varFN) 

Set treModels.Selectedltem = nodN 
Else 

Set nodN = treModels.Nodes. Add(left(strlndex, Len(strlndex) - 1), _ 
tvwChild, strlndex, varFN) 
End If 

' test to see if corresponding .mdl file exists 
StrMdlFN = left(varFN, Len(varFN) - 3) & "mdl" 
If udtWAPI.FileExists(strMdlFN) = False Then 
Call MsgBox("This family has at least " & _ 

"one missing mdl file and cannot be loaded. " & _ 
"File " & StrMdlFN & " is not in the IN directory.", _ 
vbExclamation, "Error") 
ClearControls 
Exit Sub 
End If 

* add a new model to the collection 

Set udtM = mudtFam.Models.AddExisting(IN_DIRECTORY & varFN, _ 

mudtFam . ItemType) 
If udtM.IsFrozen Then 

nodN.Image = imSnowflake 
Else 

nodN.Image = imSun 
End If 

nodN.Expanded = True 
nodN.sorted = True 
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Next inti 



* enable attributes button 
cmdSetAttributes.Enabled = True 

' force event to set active model 
treModels_Click 

Cancel: 

UpdateTabOControlStates 

Exit Sub 
End Sub 

Private Sub ninuFileImportItem_Click() 

Dim udtini As New IniFile 
Dim strFN As String 

' clear out everything 
ClearControls 

With cdlCD 

.InitDir = IN_DIRECTORY 

.FileName = 

.CancelError = True 

.DialogTitle = "Open locked item" 

.Filter = "Item Doc Files (*.doc)|*.docr 

.DefaultExt = ".doc" 

.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.Shov^Open 
On Error GoTo 0 
StrFN = .FileName 
End With 
' End If 

* exit if there's no file name 
IfLen(strFN) = OThen 

Exit Sub 
End If 

' don't allow locked item to be opened if it's not in the "IN" directory 
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If InStr(l, strFN, IN_DIRECTORY, vbTextCompare) Then 

' do nothing 
Else 

Call MsgBoxC'Locked item must be located in " & IN_DIRECTORY, _ 

vbExclamation, "Error") 
Exit Sub 
End If 

' set the FN of the ini that accompanies the locked item 

udtlni.FN = IN DIRECTORY & ExtractFileNameNoExt(strFN) & ".ini" 

Dim udtW As New Win32API 

If udtW,FileExists(udtIni.FN) = False Then 

Call MsgBox("Ini file must accompany locked item " & ExtractFileName(strFN) & _ 
".", vbExclamation, "Error") 

Exit Sub 
End If 

Dim udtProgram As Program 

Dim udtDeliveryMode As DeliveryMode 

Dim udtltemType As ItemType 

Dim strAccNum As String 

' find out about this locked item firom the .ini file 
Select Case udtIni.GetProfileString("LockedItemData", "Program") 
Case "GRE" 

udtProgram = prGRE 
Case "GMAT" 

udtProgram = prGM AT 
Case "SAT" 

udtProgram = prS AT 
Case "Not Found" 

Call MsgBox("No Program entry found in ini file " & ExtractFileName(strFN) & _ 

".", vbExclamation, "Error") 
Exit Sub 
End Select 

Select Case udtIni.GetProfileString("LockedItemData", "DeliveryMode") 
Case "CBT" 

udtDeliveryMode = dmCBT 
Case "PPT" 

udtDeliveryMode = dmPPT 
Case "Not Found" 

Call MsgBox("No DeliveryMode entry found in ini file " & ExtractFileName(strFN) & 
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vbExclamation, "Error") 
Exit Sub 
End Select 

Select Case udtIni.GetProfileString("LockedItemData", "ItemType") 
Case "MC Item", "QantDisc", "MC", "Multiple Choice" 

udtltemType = ptStandardMC 
Case "DataSufr, "DS", "Data Sufficiency" 

udtltemType = ptDataSuff 
Case "QC Discrete", "QantComp", "QC", "Quantitative Comparison" 

udtltemType = ptQuantComp 
Case "Not Found" 

Call MsgBox("No ItemType entry found in ini file " & ExtractFileName(strFN) & _ 

".", vbExclamation, "Error") 
Exit Sub 
End Select 

strAccNum = udtIni.GetProfileString("LockedItemData", " Locked Accnum") 
If StrAccNum = "Not Found" Then strAccNum = "" 

* initialize locked item object 
Dim udtLI As New Lockedltem 

udtLI.LockedltemFileName = strFN 
udtLI.Wordlnstance = mudtWord 

If udtLI.OpenLockedltemDoc = False Then ' we couldn't figure out what doc and item type it 
was 

Call MsgBox("Locked item file appears to be damaged.", vbExclamation, "Error") 
udtLLCloseLockedltemDoc 
Exit Sub 
End If 

With cdlCD 
.FileName - "" 

.DialogTitle = "Save new family based on this locked item as" 
.Filter = "Model Doc Files (*$R.doc)|*$R.doc|" 
.DefaultExt = ".doc" 
.Flags = cdlOFNHideReadOnly 
On Error GoTo CloseAndCancel 
.ShowSave 
On Error GoTo 0 
StrFN = .FileName 
End With 
' End If 
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' see if an FN was entered 
IfLen(strFN) = OThen 

Beep 

Exit Sub 
End If 

strFN = UCase(strFN) 
' check the extension 

If (InStr(l, StrFN, ".doc", vbTextCompare)) = 0 Then 

Call MsgBox("Invalid file name extension.", vbExclamation, "Error") 

Exit Sub 
End If 

Dim varl As Variant 

' embed $R into FN if the user hasn't 

If InStr(l, StrFN, "SR.doc", vbTextCompare) = 0 Then 

varl = InStr(l, strFN, ".doc", vbTextCompare) 

StrFN = Mid(strFN, 1, varl - 1) & "SR.doc" 
End If 

• check for unique FN 

Dim udtWAPI As New Win32API 

If udtWAPI.FileExists(strFN) Then 
Call MsgBox("File name " & _ 
ExtractFileName(strFN) & " is not unique.", _ 
vbExclamation, "Error") 
Exit Sub 
End If 

' copy the ini file of the locked item to the family name 
Call FileCopy(udtIni.FN, left(strFN, Len(strFN) - 3) & "ini") 

Dim strShortFN As String 
strShortFN = ExtractFileName(strFN) 

' create a new family object 
Set mudtFam = New Family 

' put family name on status bar 
stbS.Panels(pnFamilyName) = strShortFN 

' set file name, program, and item type 
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mudtFam.FileName = strFN 
mudtPam.Program = udtProgram 
mudtFam.ItemType = udtltemType 
mudtFam.AccNum = strAccNum 
mudtFam.IsDirty = True 

' format tab 2 

Call FormatTab2(mudtFam.ItemType) 

* copy correct Word template to new model FN 
Select Case mudtFam.ItemType 

Case ptStandardMC 

FileCopy App.path & "\TCASMC.doc", strFN 

Case ptQuantComp 
FileCopy App.path & "\TCAQC.doc", strFN 

Case ptDataSuff 
FileCopy App.path & "\TCADS.doc", strFN 

End Select 

Dim nodN As Node 

* clear out the treeview box 
treModels.Nodes. Clear 

* add the new root 

Set nodN = treModels,Nodes.Add(, , "R", strShortFN, imSun) 
nodN.Expanded = True 
nodN. sorted = True 
nodN.Selected = True 

Call mudtFam.Models.AddNew(strFN, mudtFam.ItemType) 

mudtFam.Generic = False 
mudtFam.Proximity = prNear 

' enable attributes button 
cmdSetAttributes. Enabled = True 

' force event to set attributes 
cmdSetAttributes_Click 
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' force event to set active model 
treModels_Click 

Select Case udtltemType 
Case ptStandardMC 
5 Select Case udtDeliveryMode 

Case dmCBT 

Call udtLI.ConvertCBTSMCItem 
Case dmPPT 

Call udtLI.ConvertPPTSMCItem 
10 End Select 

Case ptDataSuff 

Call udtLI.ConvertDSItem 
Case ptQuantComp 

Select Case udtDeliveryMode 
15 CasedmCBT 

Call udtLI.ConvertCBTQCItem 
Case dmPPT 
Call udtLI.ConvertPPTQCItem 
End Select 
2|S End Select 

! :; : 
TO* s 

Close AndCancel: 
41- udtLI.CloseLockedltemDoc 
Cancel: 

i_ J 

UpdateTabOControlStates 
2pJ Exit Sub 



End Sub 

Private Sub mnuFileExit_Click() 

Call Form_Unload(0) 
End 

30 End Sub 

'Private Sub RetumToTabOQ 

t 

' Dim intPrevTab As Integer 
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' If sstMainTab.Tab = 0 Then Exit Sub 

* intPrevTab = sstMainTab.Tab 

' sstMainTab.Tab = 0 

' Call sstMainTab_Click(intPrevTab) 

'End Sub 

Private Sub mnuFilePrintSetup_Click() 

cdlCD.Flags = cdlPDPrint Setup 

On Error GoTo Cancel 
cdlCD.ShowPrinter 
On Error GoTo 0 

Cancel: 

Exit Sub 

End Sub 

Private Sub mnuHelpAbout_Click() 

fhnAbout.Show vbModal 
End Sub 

Private Sub mnuTreeExtend_Click() 

Dim nodN As Node 
Dim strFN As String 
Dim strNewFN As String 
Dim strKey As String 
Dim strT As String 
Dim strNewKey As String 

If treModels.Selectedltem Is Nothing Then Exit Sub 

Set nodN = treModels.Selectedltem 
StrFN = nodN.Text 

* confirm this operation 

If MsgBoxC'Make a child model from model " & strFN & 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
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Exit Sub 
End If 

strKey = ModelKey(strFN) 
strNewKey = NextModelKey(strFN) 
' add the child to the tree 

strNewFN = ModelEmbedKey(strFN, strNewKey) 

Set nodN = treModels.Nodes.Add(strKey, tvwChild, strNewKey, strNewFN) 
nodN.Expanded = True 
nodN. sorted = True 
nodN.Image = imSufi 

' deactivate active model to close it before file copies, if the active 
' model is being extended. 

Dim blnReopenModel As Boolean 

bInReopenModel = False 

If strFN = stbS.Panels(pnActiveModelName) Then 

Call mudtFam.ActiveModel.CloseDoc 

blnReopenModel = True 
End If 

' make a copy of the parent's word doc for this child 

Call FileCopy(IN_DIRECTORY & strFN, IN_DIRECTORY & strNewFN) 
' make a copy of the parent's model file for this child 

Call FileCopy(IN_DIRECTORY & ModelFileName(strFN), IN_DIRECTORY & 
ModelFileName(strNewFN)) 

' add the child's model to the model collection. "Thaw" the child. 
Dim udtM As Model 

Set udtM = mudtFam.Models.AddExisting(IN_DIRECTORY & strNewFN, _ 

mud tFam . It emType) 
udtM.IsFrozen = False 

' reset the clone index of the child 
udtM.LastClone = 0 

' reset the checksums 
udtM . Ini tChecksums 

' save it 
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udtM.WriteModel 

If blnReopenModel Then 

Call mudtFam.ActiveModel.OpenDoc(mudtWord) 
End If 

End Sub 

Private Sub ninuTreeRemove_Click() 

Dim nodN As Node 
Dim strFN As String 
Dim strKey As String 

If treModels.Selectedltem Is Nothing Then Exit Sub 

Set nodN = treModels.Selectedltem 
StrFN = nodN. Text 

StrKey = ModelKey(strFN) 

Dim collndices As New Collection 

* don't remove if this node or any descendant nodes are frozen 
Dim udtModel As Model 

' check selected node 

If treModels.Selectedltem.index = 1 Then ' it's the root model 

Call MsgBox("The root model can't be removed.", vbExclamation, "Error") 
Exit Sub 

End If 

Set udtModel = mudtFam.Models.Item(treModels.Selectedltem) 
If udtModeLIsFrozen Then 

Call MsgBox("Can't remove frozen model.", vbExclamation, "Error") 

Exit Sub 
Else 

Call colIndices.Add(treModels.Selectedltem.index) 
End If 

Dim blnDone As Boolean 
bhiDone = False 

' check if any of it's descendants are frozen 
Do 
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Set nodN = nodN.Child 
If nodN Is Nothing Then 

* do nothing 
Else 

5 Do 

If mudtFam.Models.Item(nodN.Text).IsFrozen Then 

Call MsgBox("Can't remove model with one or more frozen descendants.", 

vbExclamation, "Error") 
Exit Sub 
10 End If 

Call colIndices.Add(nodN.index) 
Loop Until nodN.index = nodN.LastSibling.index 
End If 

Loop Until nodN Is Nothing 

1 5 ' confirm this operation 

If MsgBox("Remove model " & strFN & " and it's children?", _ 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
Exit Sub 
^? End If 

2^1 ' close active model document as v^e're deleting it 

%^ mudtFam.ActiveModel.CloseDoc 

: : 1 

jj; mudtFam. ActiveModel = Nothing 

stbS.Panels(pnActiveModelIcon).Picture = Nothing 
- stbS.Panels(pnActiveModelName) = "" 

i J 

2S3 Dim varlndex As Variant 

' remove all effected models from the family 
if For Each varlndex In collndices 

Call mudtFam.Models.Remove(treModels.Nodes(varIndex)) 
Kill IN_DIRECTORY & left(treModels.Nodes(varIndex), _ 
30 Len(treModels.Nodes(varIndex)) - 3) & "*" 

Next varlndex 

' remove them from the tree control 

Call treModels.Nodes.Remove(colIndices( 1 )) 

End Sub 

35 Private Sub mnu Variables Add_Click() 
frmVariable. AddEditFlag = aeAdd 
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End Sub 



Private Sub mnuVariabIesEdit_Click() 

frmVariable.AddEditFlag = aeEdit 
End Sub 

Private Sub ninuVariablesRemove_Click() 

Dim intind As Integer 

intind = IstVariables.Listlndex ' Get index 

' Make sure list item is selected 
IfintInd<OThen 

Beep 

Exit Sub 
End If 

Dim strVN As String 

strVN = mudtFamActiveModeL Variables Jtem(Str(lstVariables.IteniData(intInd))). 
' confirm this operation 

If MsgBoxC'Remove variable " & strVN & "?", _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

Exit Sub 
End If 

* Remove the variable from the collection using the key in the list box 

Call mudtFam.ActiveModel.Variables.Remove(Str(lstVariables.ItemData(intInd))) 

' Remove the variable from the list box 
Call IstVariables.Removeltem(intlnd) 

UpdateTab 1 ControlStates 

End Sub 

'Empty the variable list box 

Private Sub mnuVariablesRemoveAll_Click() 

' confirm this operation 

If MsgBox("Remove all variables?", _ 
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In 



vbQuestion + vbYesNo, "Confirm") = vbNo Then 
Exit Sub 
End If 

'clear the list box 
5 IstVariables. Clear 

' empty the collection 

mudtF am. ActiveModel. Variables. Clear 

UpdateTab 1 ControlStates 

End Sub 

10 Private Sub mnuVariablesEnableAll__Click() 
Call SetAllCheckboxes(True) 
UpdateTab 1 ControlStates 
End Sub 

4^ Private Sub mnuVariablesDisableAll_Click() 
11= Call SetAllCheckboxes(False) 

^ UpdateTab 1 ControlStates 

5 End Sub 

^ Private Sub mnuVariablesTest_Click() 

Call TestConstraints(tcTestVariables) 

20 End Sub 

Private Sub mnuConstraintsAdd_Click() 

' set the add flag for fhnConstraints 
frmConstraints.AddEditFlag = aeAdd 
' set the list box 

25 frmConstraints.ListBox = IstConstraints(mintConstrLBInd) 

' set the model 

frmConstraints.Model = mudtF am. ActiveModel 
' set the constraint type 

fhnConstraints. ConstraintType = mintConstrLBInd 
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' crank up the form 
frmConstraints.Show vbModal 

Call UpdateTabl Controls tates(mintConstrLBInd) 

End Sub 

5 Private Sub mnuConstraintsEdit_Click() 

If lstConstraints(mintConstrLBInd).ListIndex >= 0 Then * Make sure list item is selected 
' set the edit flag for frmConstraints 
frmConstraints.AddEditFlag = aeEdit 
' set the list box 

10 frmConstraints.ListBox = IstConstraints(mintConstrLBInd) 

* set the model 

frmConstraints.Model = mudtFam.ActiveModel 
' set the constraint 

With IstConstraints(mintConstrLBInd) 
1 frmConstraints . Constraint = _ 

7^ mudtFam.ActiveModel.Constraints.Item(Str(.ItemData(.ListIndex))) 

End With 
yi ' set the constraint type 

fhnConstraints.ConstraintType = mintConstrLBInd 
2Q) ' crank up the form 

4- frmConstraints.Show vbModal 

@ Else 

Cj End If 

2|f Call UpdateTabl Controls tates(mintConstrLBInd) 

S End Sub 

Private Sub mnuConstraintsRemove_Click() 

Dim intind As Integer 

intind = lstConstraints(mintConstrLBInd).ListIndex ' Get index 

30 ' Make sure list item is selected 

If intind < 0 Then 

Beep 

Exit Sub 
End If 
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Dim udtCon As Constraint 
Set udtCon = _ 

mudtFani.ActiveModel.Constraints.Iteni(Str(lstConstraints(mintConstrLBInd).IteniData(intInd)) 
) 

' confirm this operation 

If MsgBox("Remove constraint " & udtCon. Constraints tring & "?", _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

Exit Sub 
End If 

' Remove the variable from the collection using the key in the list box 
Call 

mudtFam.ActiveModeLConstraints.Remove(Str(lstConstraints(mintConstrLBInd).ItemData(intI 
nd))) 

' Remove the variable from the list box 

Call lstConstraints(mintConstrLBInd).RemoveItem(intInd) 

Call UpdateTab 1 ControlStates(mintConstrLBInd) 

End Sub 

Private Sub mnuConstraintsRemoveAll_Click() 

' confirm this operation 
If MsgBox("Remove all constraints in this list box?", _ 

vbQuestion + vbYesNo, "Confirm") = vbNo Then 

Exit Sub 
End If 

'clear the hst box 

IstConstraints(mintConstrLBInd). Clear 
' empty the collection 

Call mudtF am. ActiveModel. Constraints. Clear(mintConstrLBInd) 
Call UpdateTab 1 ControlStates(mintConstrLBInd) 
End Sub 

Private Sub mnuConstraintsEnableAll_Click() 
Call SetAllCheckboxes(True) 
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Call UpdateTab 1 ControlStates(mintConstrLBInd) 
End Sub 

Private Sub mnuConstraintsDisableAll_Click() 
Call SetAllCheckboxes(False) 
5 Call UpdateTab 1 ControlStates(mintConstrLBInd) 

End Sub 

Private Sub nmuConstraintsTest_Click() 

cmdSaveModel_Click * force a save 

Select Case mintConstrLBInd 
10 Case ctVariation 

f^j Call TestConstraints(tcTestVariationConstraints) 

^"f Case ctDistractor 

01 Call TestConstraints(tcTestDistractorConstraints) 

Ul End Select 

W End Sub 

Private Sub ninuAcceptedProfile_Click() 

% Dim udtClone As Clone 

1^ Dim inti As Integer 

Q ' set the family 

2g3 fhnDifficulty.Family = mudtFam 

' set the clone 
With IstAccepted 

For intI = 0 To .ListCount - 1 
If .Selected(intI)Then 
25 Set udtClone = _ 

mudtFam.Clones.Item(Str(.ItemData(intI))) 
fhnDifficulty.Clone = udtClone 
Exit For 
End If 

30 Next intI 

End With 
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' give frmDifficulty a caption 
frmDifficulty.Caption = "Profile of variant " & _ 
ExtractFileName(udtClone.FileName) 

* crank up the form 
frmDifficulty.Show vbModal 

If udtClone.IsRouted Then 

IstAccepted.List(intl) = udtClone.FileName & ": Routed to TCS" 
Else 

IstAccepted.List(intl) = udtClone.FileName 
End If 

End Sub 

Private Sub mnuAcceptedCopy_Click() 
Dim udtClone As Clone 

* this menu option is only active if a variant with a completed profile 

* is currently selected. 
With IstAccepted 

Set udtClone = mudtFam.Clones.Item(Str(.ItemData(.ListIndex))) 
End With 

' copy necessary stuff into a holding area 
Set mudtClone = udtClone 

UpdateTabOControlStates 

End Sub 

* this menu option is only active if a profile has been copied 
Private Sub mnuAcceptedPaste_Click() 

Dim udtClone As Clone 
Dim inti As Integer 

With IstAccepted 
If .SelCount>OThen 
' confirm this operation 

If MsgBox("Paste profile of variant " & mudtClone.FileName & 
" to all selected variants?", _ 
vbQuestion + vbYesNo, "Confirm") = vbNo Then 
Exit Sub 
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End If 

For inti = 0 To .ListCount - 1 
If .Selected(intl) Then 

Set udtClone = mudtFam.Clones.Item(Str(.ItemData(intI))) 
' copy necessary stuff from the holding area 
udtClone.Domain = mudtClone.Domain 
udtClone.BatchID = mudtClone.BatchID 
udtClone.DeHveryMode = mudtClone.DeliveryMode 
udtClone.Nature = mudtClone.Nature 
udtClone.IsRouted = mudtClone.IsRouted 
udtClone.TDEstimate = mudtClone.TDEstimate 
udtClone.IsDifficultyCalculated = mudtClone.IsDifficultyCalculated 
If udtClone. IsDifficultyCalculated Then 

udtClone.Difffist = mudtClone.DiffEst.Copy 
End If 

If udtClone.IsRouted Then 

.List(intl) = udtClone.FileName & Routed to TCS" 
Else 

.List(intl) = udtClone.FileName 
End If 
End If 
Next intI 
End If 
End With 

End Sub 

' checks/unchecks all checkboxes in a listbox and enable/disable their 
' associated variable or constraint objects 

Private Sub SetAllCheckboxes(ByVal blnBool As Boolean) 

Dim i As Integer 

For i = 0 To (mlstCurrentListBoxXistCount - 1) 

mlstCurrentListBox.Selected(i) = blnBool 
Next i 

Dim udtV As Variable 
Dim udtC As Constraint 

If mlstCurrentListBox.name = "IstVariables" Then 
For Each udtV In mudtFam.ActiveModel. Variables 

udtV.Enabled = blnBool 
Next udtV 
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Else 

For i = 0 To (mlstCurrentListBox.ListCount - 1) 
Set udtC = 

mudtFamActiveModel.ConstraintsJtem(Str(mlstCurrentListBoxJtemData(i))) 
udtC.Enabled = blnBool 
Next i 
End If 

End Sub 

Private Sub mwudtModelTest_PrologFinished() 
End Sub 

Private Sub sstMainTab_Click(PreviousTab As Integer) 

Static blnRecursing As Boolean 
Static bytMessage As Byte 

If blnRecursing Then 
Select Case bytMessage 
Case 1 

Call MsgBox("Open a model family using the File menu.", _ 
vbExclamation, "Error") 
Case 2 

Call MsgBox("Set the active model by clicking on a model.", _ 
vbExclamation, "Error") 
End Select 
blnRecursing = False 
Exit Sub 
End If 

' error conditions 

If sstMainTab.Tab > 0 Then 

If treModels.Nodes.Count = 0 Then ' family hasn*t been set 

bytMessage = 1 

blnRecursing = True 

sstMainTab.Tab = PreviousTab ' will trigger recursion 
Exit Sub 
End If 
End If 

If sstMainTab.Tab = 1 Or sstMainTab.Tab = 2 Then 

If mudtFam.ActiveModel Is Nothing Then ' active model has not been set 
bytMessage = 2 
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blnRecursing = True 

sstMainTab.Tab - PreviousTab ' will trigger recursion 
0 Exit Sub 

End If 
5 End If 



' if we got here, everything's ok! 
If PreviousTab = 2 Then 

txtNum2Generate = 
End If 



10 If PreviousTab = 1 Then 

If mudtFam.ActiveModel.IsDirty Then 
KillVariants 'delete any variants on tab 3 

mudtPam.ActiveModel.InitTempChecksums ' initialize temp checksums 
End If 
15 End If 

p ' save family 

.J] mudtFam.WriteFamily 

ill ' save the active model 

M If mudtFam.ActiveModel Is Nothing Then 

20 ' do nothing 

4^ Else 

mudtFam.ActiveModel. WriteModel 
End If 

fl Select Case sstMainTab.Tab 

2|j Case 0 

Q ' enable new/open 

cmdSetAttributes.Default = True 
mnuFileNew.Enabled = True 
mnuFileOpen.Enabled = True 
30 mnuFilelmportltem.Enabled = True 

If PreviousTab = 2 Then 

mudtFam.ActiveModeLCloseAUCloneDocs 
Call mudtFam.ActiveModel. OpenDoc(mudtWord) 
End If 

35 ' if there are no variants, disable the print button 

If IstAccepted.ListCount > 0 Then 
cmdPrintBatch.Enabled = True 
Else 
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cmdPrintBatch.Enabled = False 
End If 

Case 1 

cmdSaveModel.Default = True 

* disable new/open 
mnuFilcNew.Enabled = False 
mnuFileOpen.Enabled = False 
mnuFilelmportltem. Enabled = False 

' warn if variants exist in IstDisposition and model isn't frozen 
If mudtFam. ActiveModel.IsFrozen = False Then 
If IstDisposition.ListCount > 0 Then ' variants exist 

Call MsgBox(" Variants on tab 3 will be deleted if " & _ 
"the model is changed.", vblnformation, "Warning") 
End If 
End If 

If PreviousTab = 0 Then 

mudtFam.CloseAllCloneDocs 

Call mudtFam.ActiveModeLOpenDoc(mudtWord) 
End If 

If PreviousTab = 2 Then 

mudtFam.ActiveModel.CloseAUCloneDocs 

Call mudtFam.ActiveModel.OpenDoc(mudtWord) 

End If 

Case 2 

cmdGenerate.Default = True 

* disable new/open 
mnuFileNew.Enabled = False 
mnuFileOpen.Enabled = False 
mnuFilelmportltem.Enabled = False 

' disable the generate button 
cmdGenerate.Enabled = False 

' if there are no variants, disable the print button 
If IstDisposition.ListCount > 0 Then 
cmdPrintVariants.Enabled = True 
Else 

cmdPrintVariants.Enabled = False 
End If 

If PreviousTab = 0 Then 

mudtFam.CloseAllCloneDocs 
End If 
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• display the currently selected document 
With IstDisposition 

If .ListCount > 0 Then ' a valid selection has been made 
Call mudtFam.ActiveModelClones.Item _ 

(Str(.ItemData(.ListIndex))).OpenDoc(mudtWord,IN_DIRECTORY) 

Else 

Call mudtFam.ActiveModel.OpenDoc(mudtWord) 
End If 
End With 

End Select 

End Sub 

' restore full window drag, if necessary 
Private Sub sstMainTab_MouseMove(Button As Integer, _ 
Shift As Integer, X As Single, Y As Single) 

Dim udtW As Win32API 

If mblnRestoreFuUWindowDrag Then 

Set udtW = New Win32API 

udtW.TumOnFuUWindowDrag 

mblnRestoreFuUWindowDrag = False 
End If 

If mudtWord Is Nothing Then Exit Sub 

If sstMainTab.Tab = 1 Then ' do this first, as there will be an active doc 
' on tab 1 

If mudtWord. WordApp.ActiveDocument.Saved = False And _ 
cmdSaveModel. Enabled = False Then 
If Not mudtFam.ActiveModel.IsFrozen Then 
mudtFam.ActiveModel.IsDirty = True 
UpdateTab 1 ControlStates 
End If 
End If 
End If 

End Sub 

Private Sub trelV[odels_Click() 
Dim nodN As Node 
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If treModels.Selectedltem Is Nothing Then Exit Sub 
Set nodN = treModels.Selectedltem 
' put model icon and name on status bar 

stbS.Panels(pnActiveModelIcon).Picture = imlI.ListImages(nodN.Image).Picture 
stbS.Panels(pnActiveModelName) = treModels.Selectedltem 

* close doc for existing active model 

If mudtFam. ActiveModel Is Nothing Then 

' do nothing 
Else 

mudtFam.ActiveModel.CloseDoc 
End If 

' set the new active model and activate it 

mudtFam. ActiveModel = mudtFam.Models.Item(treModels. Selectedltem) 
Call mudtFam.ActiveModel.OpenDoc(mudtWord) 

* clear out the Variable Ust box 
IstVariables. Clear 

' populate the variable list box with this model's variables 
Dim udtVar As Variable 

For Each udtVar In mudtFam.ActiveModel. Variables 
With IstVariables 

Call .Addltem(udtVar.ScreenFormat) 
.ItemData(.ListCount - 1) = udtVar.index 
.Selected(.ListCount - 1) = udtVar.Enabled 
End With 
Next udtVar 

Dim inti 

' clear out the constraint list boxes 
IstConstraints(O). Clear 
lstConstraints( 1 ) .Clear 

' populate the constraint list boxes with this model's constraints 
Dim udtCon As Constraint 

For Each udtCon In mudtFam. ActiveModel.Constraints 
intI = udtCon. ConstraintType 
With IstConstraints(intl) 
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Call .Addltem(udtCon.ConstraintString) 
.ItemData(.ListCount - 1) = udtCon.index 
.Selected(.ListCount - 1) = udtCon. Enabled 
End With 
Next udtCon 

* populate comments form 

firmComments. Comment = mudtFam.ActiveModeLComments 

' clear out the clone disposition list box 
IstDisposition.Clear 

' populate the clone list box with this model's clones 
Dim udtClone As Clone 

With IstDisposition 

For Each udtClone In mudtFam. ActiveModel.Clones 
Call .AddItem(ExtractFileName(udtClone.FileName)) 
.ItemData(.ListCount - 1) = udtClone.index 
Next udtClone 
End With 

' save the active model 
mudtFam.ActiveModel.WriteModel 

' adjust menu^utton states depending on active model properties 

UpdateTab 1 ControlStates 

UpdateTab2ControlStates 

' enable extend 

mnuTreeExtend.Enabled = True 
End Sub 

Private Sub treModels_MouseUp(Button As Integer, Shift As Integer, 
X As Single, Y As Single) 

If treModels.Nodes.Count > 0 Then 

If Button = vbRightButton Then 
PopupMenu mnuTree 

End If 
End If 

End Sub 
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Private Sub txtNum2Generate_Change() 

• If Val(txtNum2Generate) > 0 Then 
' cmdGenerate.Enabled = True 

' Else 

' cmdGenerate.Enabled = False 
' End If 

End Sub 

Private Sub txtVariablize_GotFocus() 

If mudtWord.DocumentsCount = 0 Then 

Beep 
Else 

If mudtWord.SelectionType < wdSelectionNormal Then 

Call MsgBox("Nothing is selected.", vbExclamation, "Error") 
Else 

Call AddUndefinedVariables(mudtWord. SelectionText) 
End If 
End If 

End Sub 

* scans a string for undefined variable names and add them to 
' the variable collection and list box 

Public Sub AddUndefmedVariables(ByVal strNames As String) 

Dim colC As Collection 

Dim strS As Variant 

Dim udtVar As Variable 

Dim colDummy As New Collection 

Set colC = UndefmedNames(strNames) 

* don't do it if the model is frozen! 
If Not mudtFam Is Nothing Then 

If Not mudtFam.ActiveModel Is Nothing Then 
If mudtFam. ActiveModel.IsFrozen Then 

Call MsgBox("Variables cannot be added to a frozen model." 

vbExclamation, "Error") 
Exit Sub 
End If 
End If 
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End If 



For Each strS In colC 

If MsgBox("Auto-define variable " & strS & "?", vbQuestion + vbYesNo, 
"New variable detected") = vbYes Then 

Select Case left(strS, 1) 
Case "I" 

Set udtVar = mudtFam.ActiveModel.Variables.AddInteger(strS, _ 
True, "1", "100", "1", False, True) 
Case "R" 

Set udtVar = mudtFam.ActiveModel.Variables.AddReal(strS, _ 
True, "1", "100", "1", False, True, True, ".01", True) 
Case "S" 

Set udtVar = mudtFam.ActiveModel.Variables.AddString(strS, _ 
True, True, Chr(164), True, colDummy) 
Case "F" 

Set udtVar = mudtFam.ActiveModel.Variables.AddFraction(strS, 
True, "1", "1", "100", "1", "1", ",1", False, True, False) 
Case "U" 

Set udtVar = mudtFam.ActiveModel.Variables.AddUntyped(strS, 
True, False) 
Case Else * assume untyped 

Set udtVar = mudtFam.ActiveModel.Variables.AddUntyped(strS, 
True, False) 
End Select 

With IstVariables 

* Add the new variable to the variable list box 
Call .Addlteni(udtVar.ScreenFomiat) 

* Set ItemData to index value of the variable object 
JtemData(.ListCount - 1) = udtVar.index 

* Check the check box 
.Selected(.ListCount - 1) = True 

End With 

End If 
Next StrS 

' update control states 
IfcolC.Count>OThen 

UpdateTab 1 ControlStates 
End If 
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End Sub 

' accepts a string and parses it for undefined variable names. Returns a 
* collection of the variable names that are unique. 

Public Function UndefmedNames(ByVal strS As String) As Collection 

5 Dim IngStart As Long 

Dim IngEnd As Long 
Dim strT As String 
Dim bytl As Byte 
Dim byt2 As Byte 
1 0 Dim colC As New Collection 

Dim blnDup As Boolean 
Dim varT As Variant 

' parse the variable names out of strS 
For IngStart - 1 To Len(strS) 
IS.. bytl - Asc(Mid(strS, IngStart, 1)) 

5 If bytl >= 65 And bytl 90 Then 

J For IngEnd - IngStart + 1 To Len(strS) 

yi byt2 = Asc(Mid(strS, IngEnd, 1)) 

Select Case byt2 
im Case 48 To 57, 65 To 90, 97 To 122 

' if it's 0 to 9, A to Z, or a to z, continue searching 
Case Else 

' if if s not, assume end of variable name has been found 
Exit For 
2if End Select 

Next IngEnd 

K StrT = Mid(strS, IngStart, IngEnd - IngStart) 

Q ' throw name away if it's already in colC 

blnDup = False 
30 For Each varT In colC 

If UCase(varT) = UCase(strT) Then 

blnDup = True 
End If 
Next varT 

35 ' make sure name is not a Prolog function 

If blnDup = False Then 

' throw name away if it's already in the main variable collection 
If mudtFam.ActiveModel.Variables.UniqueName(strT) Then 
Call colC.Add(strT) 
40 End If 

End If 
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IngStart = IngEnd 
End If 
Next IngStart 

Set UndefinedNames = colC 
End Function 

Private Sub TestConstraints(ByVal udtTestType As TestType) 

Dim strVN As String 

Dim blnUnderconstrained As Boolean 

Dim blnTestAborted As Boolean 



If mudtFam.ActiveModel.ConstraintsOK(udtTestType, mudtProlog, _ 
blnUnderconstrained, blnTestAborted, strVN) Then 

Call MsgBoxC'Looks good!", vbExclamation, "Test Result") 
Elself blnTestAborted Then 
l|i Call MsgBox("Test aborted!", vbExclamation, "Test Result") 

Elself blnUnderconstrained Then 

Call MsgBox(" Variable " & strVN & " is underconstrained!", _ 
U1 vbExclamation, "Test Result") 

4S Else 

2# Call MsgBox("No solutions exist!", vbExclamation, "Test Result") 

f End If 

L End Sub 

* displays the family attributes on the status bar 



Private Sub UpdateFamilyAttributesQ 



Select Case mudtFam.Program 
Case prGRE 

stbS.Panels(pnProgramName) = "GRE" 
Case prGMAT 
30 stbS.Panels(pnProgramName) = "GMAT" 

Case prSAT 

stbS.Panels(pnProgramName) = "SAT" 
End Select 

Select Case mudtFam.ItemType 
35 Case ptStandardMC 

stbS.Panels(pnItemType) = "SMC" 
Case ptQuantComp 
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stbS.Panels(pnItemType) = "QC" 
Case ptDataSuff 

stbS.Panels(pnItemType) = "DS" 
End Select 

If mudtFam.Generic Then 

stbS.Panels(pnGeneric) = "Generic" 
Else 

stbS.Panels(pnGeneric) = "Non generic" 
End If 

Select Case mudtFam.Proximity 
Case prNear 

stbS.Panels(pnProximity) = "Near" 
Case prMedium 

stbS.Panels(pnProximity) = "Medium" 
Case prFar 

stbS.Panels(pnProximity) = "Far" 
End Select 

End Sub 

' returns the model file name given the doc file name 

Private Function ModelFileName(ByVal strDocFN As String) As String 

ModelFileName = left(strDocFN, Len(strDocFN) - 4) & ".mdl" 
End Function 

' extracts the key from a model file name 

Private Function ModelKey(ByVal strFN As String) As String 

Dim varll As Variant 
Dim varI2 As Variant 
Dim inti As Integer 
Dim strS As String 

varll =InStr(U StrFN, "$") 
varI2 = InStr(varIl, strFN, ".") 

' strip off numbers or spaces to the left of the "/' 
intI = varI2 
Do While intl> varll 
intI = intI - 1 
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strS = Mid(strFN, inti, 1) 

If Asc(strS) >= 65 And Asc(strS) <= 91 Then ' it's A to Z 

varI2 = intI + 1 

Exit Do 
End If 
Loop 

ModelKey = Mid(strFN, varll + 1, varI2 - varll - 1) 
End Function 

' embeds a new key into a model file name 

Private Function ModelEmbedKey(ByVal strFN As String, ByVal strNewKey As String) 
As String 

Dim varll As Variant 
Dim varI2 As Variant 
Dim intI As Integer 
Dim strS As String 

varll =InStr(l, StrFN, "$") 
varI2 = InStr(varI 1 , strFN, " . ") 

' strip off numbers or spaces to the left of the "." 
intI = varI2 
Do While intl> varll 
intI = intI - 1 

strS = Mid(strFN, intI, 1) 

If Asc(strS) >= 65 And Asc(strS) <= 91 Then ' it's A to Z 

varI2 = intI + 1 

Exit Do 
End If 
Loop 

ModelEmbedKey = left(strFN, varll) & strNewKey & right(strFN, 4) 
End Function 

' returns the key of the next child for this model 

Private Function NextModelKey(strFN As String) As String 

Dim nodN As Node 
Dim strNewFN As String 
Dim strlndex As String 
Dim strT As String 
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strlndex = ModelKey(strFN) 



Dim inti As Integer 

' when the key can't be found in the Nodes collection, an error 
' is raised. When the error is raised, the first available letter 
' of the alphabet has been found. 

On Error GoTo Found 

For intI = 65 To 90 * A thru Z 
strT = Chr(intl) 

Set nodN = treModels.Nodes.Iteni(strIndex & strT) 
Next intI 

On Error GoTo 0 

Call MsgBox("Can't add another child model to this parent", _ 

vbExclamation, "Error") 
Exit Function 

Found: 

NextModelKey = strlndex & strT 
Exit Function 

End Function 

' resets controls and variables w^hen a new family is opened. 
Private Sub ClearControlsQ 

If mudtFam Is Nothing Then 

' do nothing 
Else 

mudtFam.WriteFamily 

If mudtFam. ActiveModel Is Nothing Then 

' do nothing 
Else 

mudtFam.ActiveModel.WriteModel 
End If 
End If 

mudtWord.CloseAUDocs 
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Set mudtFam = Nothing 
Set mudtClone = Nothing 

treModels.Nodes. Clear 
IstVariables. Clear 
IstDisposition.Clear 
IstAccepted. Clear 
stbS.Panels(prLProgramName) = 
stbS.Panels(pnFamilyName) = 
stbS.Panels(pnItemType) = 
stbS.Panels(pnGeneric) = 
stbS.Panels(pnProximity) = "" 
stbS.Panels(pnActiveModelIcon). Picture = Nothing 
stbS.Panels(pnActiveModelName) = 
frrnCornments. Comment = 
mnuAcceptedCopy.Enabled = False 
mnuAcceptedPaste.Enabled = False 

End Sub 

' used to reformat tab 2 as QC and DS don't need a distractor listbox 
Private Sub FormatTab2(ByVal udtltemType As ItemType) 

Select Case udtltemType 
Case ptStandardMC 

' turn on the distractor list box 

IblDistractor. Visible = True 

lstConstraints(l).Visible = True 

cmdConstraintAdd(l). Visible = True 

cmdConstraintEdit(l). Visible = True 

cmdConstraintRemove(l). Visible = True 

cmdConstraintTest(l). Visible = True 
Case ptQuantComp 

' turn off the distractor list box 

IblDistractor. Visible = False 

IstConstraints(l). Visible = False 

cmdConstraintAdd(l). Visible = False 

cmdConstraintEdit(l). Visible = False 

cmdConstraintRemove(l).Visible = False 

cmdConstraintTest(l). Visible = False 
Case ptDataSuff 

' turn off the distractor list box 

IblDistractor.Visible = False 

IstConstraints(l). Visible = False 

cmdConstraintAdd(l). Visible = False 
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cindConstraintEdit(l). Visible = False 
cmdConstraintRemove(l). Visible = False 
cmdConstraintTest(l). Visible = False 
End Select 

End Sub 

' this method gets rid of all variants in the IstDisposition listbox, 
' deletes them from disk, and removes them from the active model. 

Private Sub KillVariantsQ 

Dim udtClone As Clone 
Dim inti As Integer 

With IstDisposition 

For intI = 0 To .ListCount - 1 

' get object from active model's clone collection 

Set udtClone = mudtFam. ActiveModeLClones.Item(Str(.ItemData(intI))) 
* close the document 
udtClone.CloseDoc 
' delete the clone file 

Kill IN_DIRECTORY & udtClone.FileName 
' remove the clone from the active model's collection 
Call mudtFam.ActiveModel.Clones,Remove(Str(.ItemData(intI))) 
Next intI 

For intI = .ListCount - 1 To 0 Step -1 

' remove the entry from the disposition Ust box 

Call .Removeltem(intl) 
Next intI 
End With 

End Sub 

Private Sub UpdateTabOControlStatesQ 

' update model tree menu states 
With treModels 

If .Nodes.Count > 0 Then 

mnuTreeExtend.Enabled = True 
mnuTreeRemove. Enabled = True 
cmdTreeExtend.Enabled = True 
cmdTreeRemove. Enabled = True 
Else 

mnuTreeExtend.Enabled = False 
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mnuTreeRemove.Enabled = False 
cmdTreeExtend. Enabled = False 
cmdTreeRemove.Enabled = False 
End If 
End With 

* update accepted list box menu states 
With IstAccepted 
If .ListCount>OThen 

cmdPrintBatch.Enabled = True 

If .SelCount = 1 Then ' 1 item is selected 

mnuAcceptedProfile.Enabled = True 

mnuAcceptedCopy.Enabled = True 

cmdAcceptedEdit.Enabled = True 

cmdAcceptedCopy.Enabled = True 
Elself .SelCount > 1 Then * more than one is selected 

mnuAcceptedProfile.Enabled = False 

mnuAcceptedCopy.Enabled = False 

cmdAcceptedEdit.Enabled = False 

cmdAcceptedCopy.Enabled = False 
End If 

Else * nothings in the list box 

cmdPrintBatch.Enabled = False 

mnuAcceptedProfile.Enabled = False 

mnuAcceptedCopy.Enabled = False 

mnuAcceptedPaste.Enabled = False 

cmdAcceptedEdit.Enabled = False 

cmdAcceptedCopy.Enabled = False 

cmdAcceptedPaste.Enabled = False 
End If 
End With 

If mudtClone Is Nothing Then ' nothing to paste 

mnuAcceptedPaste.Enabled =^ False 

cmdAcceptedPaste.Enabled = False 
Elself IstAccepted. SelCount > 0 Then ' one or more are selected 

mnuAcceptedPaste.Enabled = True 

cmdAcceptedPaste.Enabled - True 
Else ' none are selected 

mnuAcceptedPaste.Enabled = False 

cmdAcceptedPaste.Enabled = False 
End If 

If mudtFam Is Nothing Then 
cmdDone.Enabled = False 
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Else 

cmdDone.Enabled = True 
End If 

End Sub 

Private Sub UpdateTablControlStates(Optional ByVal intlndex As Integer 

Dim strCaption As String 

If mudtFam. ActiveModel.IsFrozen Then 

StrCaption = "Browse" 
Else 

StrCaption = "Edit" 
End If 

mnuVariablesEdit.Caption = strCaption 
cmdVariableEdit.Caption = strCaption 
ninuConstraintsEdit.Caption = strCaption 
cmdConstraintEdit(0).Caption ^ strCaption 
cmdConstraintEdit(l). Caption = strCaption 

' update variable list box menu states 
If mudtFam.ActiveModel.IsFrozen Then 

mnuVariablesAdd. Enabled = False 

mnuVariablesEdit.Enabled = True 

mnuVariablesEnableAll.Enabled = False 

mnuVariablesDisableAU. Enabled = False 

mnuVariablesRemove.Enabled = False 

mnuVariablesRemoveAll.Enabled = False 

cmdVariableAdd.Enabled = False 

cmdVariableEdit.Enabled True 

cmdVariableRemove.Enabled = False 
Elself IstVariables.ListCount > 0 Then 

mnuVariablesAdd.Enabled = True 

mnuVariablesEdit.Enabled = True 

mnuVariablesEnableAll.Enabled = True 

mnuVariablesDisableAU. Enabled = True 

mnuVariablesRemove.Enabled = True 

mnuVariablesRemoveAll.Enabled = True 

cmdVariableAdd.Enabled = True 

cmdVariableEdit.Enabled = True 

cmdVariableRemove.Enabled = True 
Else 

mnuVariablesAdd.Enabled = True 
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mnuVariablesEdit.Enabled = False 
mnuVariablesEnableAll.Enabled = False 
ninuVariablesDisableAll.Enabled = False 
mnuVariablesRemove.Enabled = False 
5 mnuVariablesRemoveAlLEnabled = False 

cmdVariableAdd.Enabled = True 
cmdVariableEdit. Enabled = False 
cmdVariableRemove.Enabled = False 
End If 

10 ' isfrozen should not effect state of test option 

If IstVariables.ListCount > 0 Then 

mnuVariablesTest.Enabled = True 

cmdVariableTest.Enabled = True 
Else 

1 5 mnuVariablesTest.Enabled = False 

cmdVariableTest.Enabled = False 
End If 

% ' update constraints list box menu states 

If mudtFam. ActiveModel.IsFrozen Then 
29/= mnuConstraintsAdd.Enabled = False 

jz mnuConstraintsEdit.Enabled = True 

ii mnuConstraintsEnableAll. Enabled = False 

•=3 J? 

mnuConstraintsDisableAll. Enabled = False 
J3 mnuConstraintsRemove.Enabled = False 

2§ mnuConstraintsRemoveAll.Enabled = False 

cmdConstraintAdd(0).Enabled = False 
cmdConstraintAdd(l). Enabled = False 
cmdConstraintEdit(0).Enabled = True 
cmdConstraintEdit(l ). Enabled = True 
3B| cmdConstraintRemove(O). Enabled = False 

cmdConstraintRemove(l). Enabled = False 
Elself lstConstraints(intIndex).ListCount > 0 Then 
mnuConstraintsAdd.Enabled = True 
mnuConstraintsEdit.Enabled = True 
35 mnuConstraintsEnableAU.Enabled = True 

mnuConstraintsDisableAU.Enabled = True 
mnuConstraintsRemove.Enabled = True 
mnuConstraintsRemoveAlLEnabled = True 
cmdConstraintAdd(intlndex). Enabled = True 
40 cmdConstraintEdit(intlndex). Enabled =^ True 

cmdConstraintRemove(intlndex). Enabled = True 
Else 

mnuConstraintsAdd.Enabled = True 
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mnuConstraintsEdit.Enabled = False 
mnuConstraintsEnableAU. Enabled = False 
mnuConstraintsDisableAll. Enabled = False 
mnuConstraintsRemove.Enabled = False 
mnuConstraintsRemoveAU.Enabled = False 
cmdConstraintAdd(intlndex). Enabled = True 
cmdConstraintEdit(intIndex).Enabled = False 
cmdConstraintRemove(intlndex). Enabled = False 
End If 

' isfrozen should not effect state of test option 
If lstConstraints(intIndex).ListCount > 0 Then 
mnuConstraintsTest.Enabled = True 
cmdConstraintTest(intlndex). Enabled = True 
Else 

mnuConstraintsTest.Enabled = False 
cmdConstraintTest(intIndex).Enabled False 
End If 

' flip the index 

If intlndex = 0 Then 

intlndex = 1 
Else 

intlndex = 0 
End If 

' update button states for the other constraint list box 
If mudtFam.ActiveModel.IsFrozen = False Then 
If lstConstraints(intIndex).ListCount > 0 Then 
cmdConstraintAdd(intIndex).Enabled = True 
cmdConstraintEdit(intIndex).Enabled = True 
cmdConstraintRemove(intlndex). Enabled = True 
Else 

cmdConstraintAdd(intlndex). Enabled = True 
cmdConstraintEdit(intlndex). Enabled = False 
cmdConstraintRemove(intlndex). Enabled = False 
End If 
End If 

' isfrozen should not effect state of test option 
If lstConstraints(intIndex).ListCount > 0 Then 

cmdConstraintTest(intlndex). Enabled = True 
Else 

cmdConstraintTest(intlndex). Enabled = False 
End If 
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' update import button 
If mudtFam.ActiveModel.IsFrozen Then 
cmdlmportConstraints. Enabled = False 
Else 

5 cmdlmportConstraints. Enabled = True 

End If 

' if model frozen, disable save 
If mudtFam.ActiveModel.IsFrozen Then 
cmdSaveModei.Enabled = False 
10 Else 

If mudtFam.ActiveModel.IsDirty Then 

cmdSaveModei.Enabled = True 
Else 

cmdSaveModei.Enabled = False 
15 End If 

End If 

End Sub 

m Private Sub UpdateTab2ControlStates() 



5« 



' Update disposition list box menu states 

If IstDisposition.ListCount > 0 And cmdGenerate.Caption = "Generate" Then 
mnuDispAccept.Enabled = True 
mnuDispDefer.Enabled = True 
mnuDispDiscard.Enabled = True 
mnuDispMakeModel.Enabled = True 
2Sf cmdPrintVariants.Enabled = True 

cmdPrintVariants.Enabled = True 
cmdDispAccept.Enabled = True 
cmdDispDefer.Enabled = True 
cmdDispDiscard.Enabled = True 
30 cmdDispMakeModel.Enabled = True 

Else 

mnuDispAccept.Enabled = False 

mnuDispDefer.Enabled False 

mnuDispDiscard.Enabled = False 
35 mnuDispMakeModel.Enabled = False 

cmdPrintVariants.Enabled = False 

cmdPrintVariants.Enabled = False 

cmdDispAccept.Enabled = False 

cmdDispDefer.Enabled = False 
40 cmdDispDiscard.Enabled = False 

cmdDispMakeModel.Enabled = False 
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End If 



' Variable.frm 
VERSION 5.00 

Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.0CX" 
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "C0MDLG32.0CX" 
5 Begin VB.Form frin Variable 

BorderStyle = 4 "Fixed ToolWindow 
Caption = "Create or Change Variable" 
ClientHeight = 4230 
ClientLeft = 45 
10 ClientTop =285 

ClientWidth = 6525 
LinkTopic = "Forml" 
MaxButton = 0 'False 
MinButton = 0 'False 
15 ScaleHeight = 4230 

ScaleWidth = 6525 
ShowInTaskbar = 0 'False 
f=^ StartUpPosition = 1 'CenterOwner 
Begin VB.ComboBox cboVarType 
m Height =315 

Ul ItemData = "Variable.£rx":0000, 

jf Left = 2040 

al List = "Variable.frx":0013 

4^ Style = 2 'Dropdown List 

2S=? Tablndex = 1 

ToolTipText = "Select the variable type." 
Top = 360 

Width =1695 

H End 

3|^ Begin VB.CheckBox chkChecksum 
F= Caption = "Add to checksum" 

Height = 375 
Left = 240 
Tablndex = 2 

35 ToolTipText = "Check this box to add this variable to the checksum calcuati on." 

Top = 840 

Value = 1 'Checked 
Width = 1815 
End 

40 Begin MSComDlg.CommonDialog cdlCD 
Left = 5280 
Top = 2520 

_ExtentX = 847 
_ExtentY = 847 
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_Version = 393216 
End 

Begin VB.CommandButton cmdVarExport 
Caption = "Export Strings" 
5 Height = 495 

Left = 5160 

Tablndex - 7 

ToolTipText = "Click here to export a set of strings." 
Top = 1920 

10 Width = 1215 

End 

Begin VB.CommandButton cmdVarlmport 
Caption = "Import Strings" 
Height = 495 
15 Left = 5160 

Tablndex = 6 

ToolTipText = "Click here to import a set of strings." 

Top = 1320 

Width = 1215 
205 End 
g"! Begin VB.TextBox txtVariableName 
ill Height = 315 

jr: Left = 240 

^ Tablndex = 0 

21'^ ToolTipText = "Enter the variable name here." 

J3 Top = 360 

Width = 1695 
% End 

2| Begin VB.CommandButton cmdVarCancel 

Caption = "Cancel" 
2=i Height = 495 

A Left = 5160 

Tablndex = 5 

ToolTipText = "Click here to return without saving changes." 
35 Top = 720 

Width = 1215 
End 

Begin VB.CommandButton cmdVarOK 
Caption = "OK" 
40 Default = -1 'True 

Height = 495 
Left =5160 
Tablndex = 4 

ToolTipText = "Click here to save changes and return." 
45 Top = 120 



VBSCA -218- 



Width = 1215 
End 

Begin ComctlLib.ListView IvwTemp 





Height 


375 


5 


Left 


5280 




Tablndex 


= 43 




Top = 


3120 




Visible = 


0 'False 




Width 


495 


10 


_ExtentX 


= 873 




_ExtentY 


= 661 




View = 


3 




Arrange = 


= 2 




LabelEdit 


= 1 


15 


MultiSelect 


= -1 True 




LabelWrap 


= -1 'True 




HideSelection 


= -1 'True 




Version 


= 327682 




ForeColor 


= -2147483640 




BackColor 


= -2147483643 




BorderStyle 


= 1 


J \% 


Appearance 


= 1 




Numltems 


= 0 




End 






Begin ComctlLib.ListView IvwDi 




Height 


375 


5 


Left 


5280 




Tablndex 


= 44 




Top = 


3600 


M 


Visible = 


. 0 'False 


Width 


495 




_ExtentX 


= 873 




_ExtentY 


= 661 




View = 


3 


35 


Arrange 


= 2 




LabelEdit 


= 1 




MultiSelect 


= -1 'True 




LabelWrap 


= -1 'True 




HideSelection 


= -1 'True 


40 


_Version 


= 327682 




ForeColor 


= -2147483640 




BackColor 


= -2147483643 




BorderStyle 


= 1 




Appearance 


= 1 


45 


Numltems 


= 0 
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End 

Begin VB. Frame fraString 
BorderStyle = 0 'None 
Height = 2895 
Left = 240 
Tablndex = 9 
Top = 1200 

Width = 4815 
Begin ComctlLib.ListView IvwStrings 



Height 


1815 


Left 


0 


Tablndex 


= 42 


Top 


720 


Width 


■ 3975 


_ExtentX 


= 7011 


_ExtentY 


= 3201 


View = 


3 


Arrange 


= 2 


LabelEdit 


= 1 


MultiSelect 


= -1 'True 


LabelWrap 


= -1 'True 


HideSelection 


= -1 'True 


Version 


= 327682 


ForeColor 


= -2147483640 


BackColor 


= -2147483643 


BorderStyle 


= 1 


Appearance 


= 1 


Numltems 


= 0 



End 

Begin VB.CheckBox chklndexed 
Caption = "Indexed" 
Height = 375 
Left =0 
Tablndex = 41 

ToolTipText = "Check this box for indexed strings." 
Top = 0 

Width = 1215 
End 

Begin VB.CommandButton cmdRemove 
Caption = "Remove" 
Height = 255 
Left = 2640 
Tablndex = 40 

ToolTipText = "CHck here to remove a set of indexed values." 
Top = 2520 
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Width = 1335 
End 

Begin VB.CommandButton cmdEdit 
Caption = "Edit" 
5 Height = 255 

Left = 1320 
Tablndex = 39 

ToolTipText = "Click here to edit a set of indexed values." 
Top = 2520 

10 Width - 1335 

End 

Begin VB.CommandButton cmdAdd 
Caption = "Add" 
Height = 255 
15 Left = 0 

Tablndex =38 

ToolTipText = "Click here to add a new set of indexed values." 
Top = 2520 

P Width = 1335 

M End 
51 Begin VB.LabellblStringVals 

li'i Caption = "String values" 

J Height = 255 

m Left = 0 

2l" Tablndex = 37 

^ Top = 480 

Width = 1695 
y ■ End 
Sf End 
30=1 Begin VB.Frame fraUntyped 
^ BorderStyle = 0 'None 

rl Height = 2895 

Left = 240 
Tablndex = 35 
35 Top = 1200 

Width =4815 
Begin VB.TextBox txtUntyped 
Height = 2295 
Left = 240 
40 Locked = -1 'True 

MultiLine = -1 'True 
Tablndex = 36 
ToolTipText = "Interesting, no?" 
Top = 360 

45 Width = 4335 
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End 
End 

Begin VB .Frame fralndependent 
BorderStyle = 0 'None 
Caption = "Frame 1" 
Height = 2895 
Left = 240 
Tablndex = 10 
Top = 1200 

Width =4815 
Begin VB.CheckBox chklslndependent 
Caption = "Independent" 
Height = 375 
Left = 0 
Tablndex = 11 

ToolTipText "Check this box if the value of this variable is not dependent." 
Top = 0 

Value = 1 'Checked 
fi Width = 1575 

2(|J End 
Oi Begin VB.Frame fraRealFormat 

U1 BorderStyle = 0 'None 

.4^ Height = 1095 

m Left = 0 

2^ Tablndex = 26 

Top = 1680 

Width =4815 
^ Begin VB.CheckBox chkOnGrid 

51 Caption = "Value must be multiple of precision" 

Sttj Height = 375 

p Left = 1800 

3 Tablndex = 45 

Top = 120 

Width = 2895 
35 End 

Begin VB.ComboBox cboPrecision 
Height = 315 
ItemData = "Variable.frx":0041 
Left = 120 
40 List = "Variable.frx":0060 

Style = 2 'Dropdown List 
Tablndex = 34 
Top = 360 

Width = 1455 
45 End 
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Begin VB.CheckBox chkTrailingZeros 
Caption = "Display trailing zeros" 
Height = 375 
Left = 1800 
5 Tablndex = 28 

Top = 480 

Width = 1935 
End 

Begin VB. Label LblDecimals 
10 Caption = "Precision" 

Height =255 
Left = 480 

Tablndex = 29 
Top = 120 

15 Width = 1095 

End 
End 

Begin VB .Frame ft'aFractionFormat 

• r'i BorderStyle = 0 'None 
2^1 Caption = "Frame 1" 

ii Height = 1215 

ill Left = -120 

Ja Tablndex = 32 

• ^3 Top = 1560 
2^= Width = 5055 

Begin VB.CheckBox chkMixedNumbers 
Caption = "Mixed numbers" 
Height = 375 
^ fi Left = 1560 

3bf Tablndex =33 

j=f ToolTipText = "Check this box if you wish improper fi"actions to be converted into 

Fn mixed numbers." 

Top = 240 

Width = 1695 

• 35 End 

End 

Begin VB .Frame fralntRealRange 
BorderStyle = 0 'None 
Height = 1335 

• 40 Left = 0 

Tablndex = 22 
Top = 360 

Width =4815 
Begin VB.TextBox txtBy 

• 45 Height = 315 
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Left = 3240 
Tablndex = 25 
Text = "1" 

ToolTipText = "Enter the increment here. Variables and expressions may be used." 
Top = 600 

Width = 1455 
End 

Begin VB.TextBox txtTo 
Height = 315 
Left = 1680 
Tablndex = 24 
Text = "100" 

ToolTipText = "Enter the value in the range here. Variables and expressions may be 

used." 

Top = 600 

Width = 1455 
End 

Begin VB.TextBox txtFrom 
Height =315 
Left =120 
Tablndex = 23 
Text = "1" 

ToolTipText = "Enter the lowest value in the range here. Variables and expressions 
may be used." 

Top = 600 

Width = 1455 
End 

Begin VB. Label IblBy 

Caption = "By" 

Height =255 

Index = 0 

Left = 3840 

Tablndex = 31 

Top = 360 

Width = 495 
End 

Begin VB. Label IblTo 

Caption = "To" 

Height = 255 

Index = 0 

Left = 2280 

Tablndex =30 

Top = 360 

Width = 615 
End 



VBSCA -224- 



Begin VB.Label IblFrom 

Caption = "From" 

Height =255 

Index = 0 

Left = 720 

Tablndex = 27 

Top = 360 

Width = 975 
End 
End 

Begin VB. Frame fraFractionRange 
BorderStyle = 0 'None 
Height = 1455 
Left = 0 
Tablndex = 12 
Top = 360 

Width = 4815 
Begin VB.TextBox txtByNum 

Height = 315 

Left = 3240 

Tablndex = 18 

Text = "1" 

ToolTipText = "Enter the numerator of the increment here." 
Top = 360 

Width = 1455 
End 

Begin VB.TextBox txtToNum 
Height = 315 
Left = 1680 
Tablndex = 17 
Text = "100" 

ToolTipText = "Enter the numerator of the highest value in the range here 
Top = 360 

Width = 1455 
End 

Begin VB.TextBox txtFromNum 
Height = 315 
Left = 120 
Tablndex = 16 
Text = "1" 

ToolTipText = "Enter the numerator of the lowest value of the range here. 
Top = 360 

Width = 1455 
End 

Begin VB.TextBox txtFromDen 
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Height = 315 
Left = 120 
Tablndex = 15 
Text = "1" 

ToolTipText = "Enter the denominator of the lowest value in the range here.' 
Top - 840 

Width = 1455 
End 

Begin VB.TextBox txtToDen 
Height = 315 
Left = 1680 
Tablndex = 14 
Text = "1" 

ToolTipText = "Enter the denominator of the highest value in the range here. 
Top = 840 

Width = 1455 
End 

Begin VB.TextBox txtByDen 
Height - 315 
Left = 3240 
Tablndex = 13 
Text = "1" 

ToolTipText = "Enter the denominator of the increment here." 
Top = 840 

Width = 1455 
End 

Begin VB.Label IblBy 

Caption = "By" 

Height = 255 

Index = 1 

Left = 3840 

Tablndex = 21 

Top = 120 

Width = 255 
End 

Begin VB.Label IblTo 

Caption = "To" 

Height = 255 

Index = 1 

Left = 2280 

Tablndex = 20 

Top = 120 

Width = 375 
End 

Begin VB.Label IblFrom 
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Caption = "From" 



Height 




= 255 


Index 




1 


Left 




480 


Tablndex 




= 19 


Top 




120 


Width 




= 495 


End 






Begin VB.Line 


Linel 


BorderWidth 


= 3 


Index 




■■ 0 


XI 




120 


X2 




1560 


Yl 




750 


Y2 




750 


End 






Begin VB.Line 


Linel 


BorderWidth 


= 3 


Index 




■ 1 


XI 




1680 


X2 




3120 


Yl 




750 


Y2 




750 


End 






Begin VB.Line 


Linel 


BorderWidth 


= 3 


Index 




■ 2 


XI 




3240 


X2 




4680 


Yl 




750 


Y2 




750 


End 







End 
End 

Begin VB.Label IblVarType 



Caption = "Type" 

Height = 255 

Left = 2040 

Tablndex = 8 

Top = 120 

Width = 1095 
End 

Begin VB.Label IblVarName 

Caption = "Variable Name" 

Height = 255 



Left = 240 

Tablndex = 3 
Top = 120 

Width = 1095 
5 End 

Begin VB.Menu mnuString 
Caption = "String" 
Visible - 0 'False 
Begin VB.Menu mnuStringAdd 
10 Caption = "Add" 

End 

Begin VB.Menu mnuStringEdit 

Caption - "Edit" 
End 

1 5 Begin VB.Menu ninuStringRemove 

Caption = "Remove" 
End 
End 
Q End 

im Attribute VB_Name = "ftmVariable" 

Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable - False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
2T1 Option Explicit 

Private mudtVar As Variable 
;]] Private mudtVarInt As Varlnteger 
Q. Private mudtVarReal As VarReal 
hh Private mudtVarFraction As VarFraction 
303 Private mudtVarString As VarString 

Private mudtVarUntyped As VarUntyped 



m 



' to see if the variable type has changed 
Private mudtType As VariableType 
Private mudtOldType As VariableType 

35 ' needed for string list box 

Private mbytAddEditFlag As Byte 

' needed for listbox update 
Private mlstListBox As ListBox 

'current active model 
40 Private mudtModel As Model 
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Public Property Let AddEditFlag(ByVal bytNewValue As Byte) 

mbytAddEditFlag = bytNewValue 
End Property 

Public Property Get AddEditFlagQ As Byte 

AddEditFlag = mbytAddEditFlag 
End Property 

Public Property Let Variable(ByVal udtNewValue As Variable) 

Set mudtVar = udtNewValue 
End Property 

Public Property Let ListBox(ByVal IstNewValue As ListBox) 

Set mlstListBox = IstNewValue 
End Property 

Public Property Let Model(ByVal udtNewValue As Model) 

Set mudtModel = udtNewValue 
End Property 

Private Sub chkIndexed_Click() 

Call CopyListView(lvwStrings, IvwTemp) 
Call CopyListView(lvwDummy, IvwStrings) 
Call CopyListView(lvwTemp, IvwDummy) 

End Sub 

Private Sub CopyListView(ByVal Ivwl As ListView, lvw2 As ListView) 

Dim inti As Integer 
Dim intI2 As Integer 
Dim Isiltem As Listltem 

* copy visible listview into temp listview 
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lvw2.ListItems. Clear 
lvw2.ColuniiiHeaders.Clear 

For inti = 1 To Ivwl.ColumnHeaders. Count 

Call lvw2.ColumnHeaders.Add(, , Ivwl.ColumnHeaders(intl)) 
Next intI 

For intI = 1 To Ivwl.Listltems.Count 

Set Isiltem = lvw2.ListItems.Add(, , Ivwl.Listltems.Item(intl).Text) 

For intI2 = 1 To Ivwl.ColumnHeaders. Count - 1 

lsiItem.SubItems(intI2) = Ivwl ,ListItems.Item(intI).SubItems(intI2) 

Next intI2 
Next intI 

End Sub 

Private Sub cmdAdd_Click() 
Call ninuStringAdd_Click 
End Sub 

Private Sub cmdEdit_Click() 
Call mnuStringEdit_Click 
End Sub 

Private Sub cmdRemove_Click() 
Call mnuStringRemove_Click 
End Sub 

Private Sub Form_Load() 

Dim udtWAPI As New Win32API 
' enable full row select 

Call udtWAPLEnableListViewFullRowSelect(lvwStrings) 

' load up explanation of untyped variables 
txtUntyped = LoadResString(l) 

' cboVarDelimiter.Listlndex = 0 ' default to "@" 
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cboPrecision.Listlndex = 1 ' default to ".01" 
cdlCD.CancelError = True 
If mbytAddEditFlag = aeEdit Then 
txtVariableName = mudtVar.name 



If mudtVar. Checksum Then 
chkChecksum = 1 
10 Else 

chkChecksum = 0 

End If 



Select Case TypeName(mudtVar) 



Case "Varlnteger" 

Set mudtVarInt = mudtVar 
n With mudtVarInt 

Jj txtFrom - .From 

201 txtTo = .Too 

yi txtBy = .By 

4= If .Islndependent Then 

^ chklslndependent = 1 

i! Else 

chklslndependent = 0 
1. End If 

J End With 

□ mudtType - vtlnteger 

sbj Case "VarReal" 

C3 Set mudtVarReal = mudtVar 

With mudtVarReal 
txtFrom = .From 
txtTo = .Too 
35 txtBy = .By 

If .Islndependent Then 
chklslndependent = 1 
Else 

chklslndependent = 0 
40 End If 

If .IsOnGrid Then 

chkOnGrid = 1 
Else 

chkOnGrid = 0 
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End If 

If .TrailingZeros Then 
chkTrailingZeros = 1 
Else 

chkTrailingZeros = 0 
End If 

cboPrecision = .Precision 
End With 

mudtType = vtReal 

Case "VarFraction" 

Set mudtVarFraction = mudtVar 
With mudtVarFraction 

txtFromNum = .FromNumerator 

txtFromDen = .FromDenominator 

txtToNum = .ToNumerator 

txtToDen = .ToDenominator 

txtByNum = .ByNumerator 

txtByDen = .ByDenominator 

If .Islndependent Then 
chklslndependent = 1 

Else 

chklslndependent = 0 
End If 

If .MixedNumbers Then 
chkMixedNumbers = 1 
Else 

chkMixedNumbers = 0 
End If 
End With 

mudtType = vtFraction 

Case "VarString" 

Set mudtVarString = mudtVar 
With mudtVarString 
mudtType = vtString 

If .Delimiter = Chr(STRING__DELIMITER) Then 

' do nothing 
Else 

ConvertDelimiter 

.Delimiter - Chr(STRING_DELIMITER) 
End If 

* load list view control 
If .Islndexed Then 
chklndexed = 1 
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Else 

chklndexed = 0 
End If 

LoadListView 
End With 

Case "VarUntyped" 

Set mudtVarUntyped = mudtVar 
mudtType = vtUntyped 

End Select 

mudtOldType = mudtType 

cboVarType.Listlndex = mudtType 'generates a cboVarType_Click event 

Else * it*s an add 

mudtType = vtlnteger 
mudtOldType = mudtType 

cboVarType.Listlndex = vtlnteger 'generates a cboVarType_Click event 
End If 

' changes control states if model is frozen 
UpdateControlStates 



End Sub 

Private Sub cmdVarOK_Click() 

* will capitalize the first letter of the variable name, if it's not 

' capitalized already. 

txtVariableName_LostFocus 

' make sure all input is valid, otherwise, make 'em fix it! 
If ValidateForm = False Then 

Exit Sub 
End If 

If mbytAddEditFlag = aeEdit Then ' we're editing an old one 

Call ProcessEdit 
Else 

Call ProcessAdd 
End If 
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Unload Me 



End Sub 

Private Sub cmdVarCancel_Click() 

Unload Me 
End Sub 

Private Sub cmdVarImport_Click() 

Dim strFN As String 

With cdlCD 
.FileName = 

.DialogTitle = "Import strings from file" 
.Filter = "String Files (*.str)|*.str|" 
.DefaultExt = ".str" 
.InitDir = "c:\tcs\tca\strings" 

.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowOpen 
On Error GoTo 0 
StrFN = .FileName 
End With 

On Error GoTo Beatit ' trap open, I/O errors 

Open StrFN For Input Access Read As 1 

Dim varR As Variant 
Dim varlndexed As Variant 
Dim varNumlndices As Variant 
Dim strMessage As String 
Dim mcolStr As Collection 
Dim inti As Integer 

Input #1, varlndexed 

If varlndexed Then 

StrMessage = "indexed." 
Else 

StrMessage = "not indexed." 
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End If 

If varlndexed o chklndexed Then 

Call MsgBox("Unable to import: file contains string values that are " & 
strMessage, vbExclamation, "Error") 

GoTo Beatit 
End If 

Input #1, varNumlndices 



Do 

Input #1, varR 
If varlndexed Then 

Set mcolStr = New Collection 
15 Call mcolStr.Add(varR) 

For inti = 1 To varNumlndices - 1 
Input #1, varR 
Call mcolStr.Add(varR) 
Next intI 

2 j j Call AddColToListView(mcolStr) 

ffi Else 

Ul Call AddStrToListView(varR) 

4= End If 

2|= Loop Until EOF(l) 

Beatit: 
9 Close 1 

3bf Cancel: 



Exit Sub 
End Sub 

Private Sub cmdVarExport ClickQ 
Dim strFN As String 
cdlCD.CancelError = True 



40 With cdlCD 

.FileName = "" 

.DialogTitle = "Export strings to file" 
.Fiher = "String Files (*.str)|*.strr' 
.DefaultExt = ".txt" 
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.InitDir = "c:\tcs\tca\strings" 

.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly 
On Error GoTo Cancel 
.ShowSave 
On Error GoTo 0 
strFN = .FileName 
End With 

On Error GoTo Beatit 

Open StrFN For Output Access Write As 1 

Dim varW As Variant 

varW = chklndexed ' so we can tell if it's indexed 
Print #l,varW 

varW = IvwStrings.ColumnHeaders.Count ' how many indices 
Print #l,varW 

Dim inti As Integer 
Dim intI2 As Integer 
Dim Isiltem As Listltem 

intI = 1 

Do * write the data 

Set Isiltem = IvwStrings.Listltems.Item(intl) 
varW = Isiltem.Text 
Print #l,varW 

If chklndexed Then 

For intI2 = 1 To IvwStrings.ColumnHeaders.Count - 1 
varW = Isiltem. SubItems(intI2) 
Print #l,varW 
Next intI2 
End If 

intI = intI + 1 

Loop Until intI > IvwStrings.Listltems. Count 

Beatit: 
Close 1 

Cancel: 
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Exit Sub 



End Sub 

Private Sub lvwStrings_MouseDown(Button As Integer, Shift As Integer, 
X As Single, Y As Single) 

If Button = vbRightButton Then 

PopupMenu ninuString 
End If 

End Sub 

Private Sub ninuStringAdd_Click() 

If chklndexed Then 
With fhnlndexedString 
' set the model 
.Model = mudtModel 
' set the edit flag 
.AddEditFlag = aeAdd 
' set var name 

.VariableName = txtVariableName 
'doit 

.Show vbModal 

If .OK Then 
Call AddCoIToListView(. SubStringCollection) 

End If 
End With 
Else 

With frmString 

' set the model 

.Model = mudtModel 

' set the string 

.StringValue = "" 

' set var name 

.VariableName = txtVariableName 
• do it 

.Show vbModal 
If .OK Then 

Call AddStrToListView(.StringValue) 
End If 
End With 
End If 
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UpdateControlStates 
End Sub 

Private Sub mnuStringEdit_Click() 
Dim colC As Collection 

If IvwStrings.Selectedltem Is Nothing Then Exit Sub ' Make sure list item is selected 

If chklndexed Then 
With frmlndexedString 
' set the model 
.Model = mudtModel 
' set the edit flag 
.AddEditFlag = aeEdit 
' set the substring collection 

.SubStringCoUection = GetSubStringCollection(lvwStrings.Selectedltem) 
' set var name 

. VariableName = txtVariableName 
'do it 

.Show vbModal 
If .OK Then 

Call UpdateListView(lvwStrings.SelectedItem, .SubStringCoUection) 
End If 
End With 
Else 

With frmString 
' set the model 
.Model = mudtModel 
' set the string 

.StringValue = IvwStrings.Selectedltem 
' set var name 

.VariableName = txtVariableName 
'do it 

.Show vbModal 
If .OK Then 

Set colC = New Collection 

Call colC.Add(. StringValue) 

Call UpdateListView(lvwStrings.SelectedItem, colC) 
End If 
End With 
End If 

End Sub 
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Private Sub mnuStringRemove_Click() 

If IvwStrings.Selectedltem Is Nothing Then Exit Sub 

If MsgBox("Remove string value " & IvwStrings.Selectedltem. Text 8l 

vbQuestion + vbYesNo) = vbNo Then 

Exit Sub 
End If 

With IvwStrings 

Call .Listltems.Remove(.Selectedltem.index) 
End With 

UpdateControlStates 
End Sub 

Private Sub chkIsIndependent_Click() 

Call FormatForm 
End Sub 

Private Sub cboVarType_CUck() 

mudtType = cboVarType.Listlndex 

Call FormatForm 
End Sub 

Private Sub txtVariableName_GotFocus() 

* Automatically select all text w^hen TextBox gets focus 
Call txtSelectAll(txtVariableName) 

End Sub 

Private Sub txtVariableName_LostFocus() 

Dim strName As String 
Dim udtVar As Variable 

' Capitalize the variable name in the textbox 
StrName = txtVariableName 
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Call CapitalizeString(strName) 
txtVariableName = strName 

End Sub 

Private Sub txtFrom_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtFrom) 

End Sub 

Private Sub txtTo GotFocusQ 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtTo) 

End Sub 

Private Sub txtBy_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtBy) 

End Sub 

Private Sub txtFromNum_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtFromNum) 

End Sub 

Private Sub txtFromDen_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtFromDen) 

End Sub 

Private Sub txtToNum_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtToNum) 
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End Sub 



Private Sub txtToDen_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtToDen) 

End Sub 

Private Sub txtByNum_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtByNum) 

End Sub 

Private Sub txtByDen_GotFocus() 

' Automatically select all text when TextBox gets focus 
Call txtSelectAll(txtByDen) 

End Sub 

Private Sub FormatForm() 

cmdVarlmport. Visible = False 
cmdVarExport.Visible = False 

chklsIndependent.TabStop = False 
txtFrom.TabStop = False 
txtTo.TabStop = False 
txtBy.TabStop - False 
txtFromNum.TabStop = False 
txtFromDen.TabStop = False 
txtToNum.TabStop = False 
txtToDen.TabStop = False 
txtByNum.TabStop = False 
txtByDen.TabStop = False 
IvwStrings.TabStop = False 
chkTrailingZeros.TabStop = False 
chkTrailingZeros.TabStop = False 
chkMixedNumbers.TabStop = False 

Select Case mudtType 



VBSCA -241- 



Case vtlnteger 

fraFractionRange. Visible = False 
fraFractionFormat. Visible = False 
fralndependent.ZOrder 

5 fralntRealRange.ZOrder 
fraRealFormat.Visible = False 
chklsIndependent.TabStop = True 
If chklslndependent Then 

fralntRealRange. Visible = Trae 
1 0 txtFrom.TabStop = True 

txtTo.TabStop = True 
txtBy.TabStop = True 
Else 

fralntRealRange. Visible = False 
15 End If 

Case vtReal 

fraFractionRange. Visible = False 
f ^ fraFractionFormat. Visible = False 

2Qj fralndependent.ZOrder 
01 fralntRealRange.ZOrder 
Ul fraRealFormat.ZOrder 
£ fraRealFormat.Visible = True 

6 chklsIndependent.TabStop = True 
2§: If chklslndependent Then 

fralntRealRange. Visible = True 
1„ txtFrom.TabStop = True 

^ txtTo.TabStop = True 

f^l txtBy.TabStop = True 

3S: Else 
p fralntRealRange. Visible = False 

Ci End If 

chkOnGrid.TabStop = True 
chkTraiUngZeros.TabStop = True 

35 

Case vtFraction 

fralntRealRange.Visible = False 
fraRealFormat.Visible = False 
fralndependent.ZOrder 

40 fraFractionRange.ZOrder 
fraF ractionFormat.ZOrder 
fraFractionFormat. Visible = True 
chklsIndependent.TabStop = True 
If chklslndependent Then 

45 fraFractionRange. Visible = True 
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txtFromNum.TabStop = True 
txtFromDen.TabStop = True 
txtToNum.TabStop = True 
txtToDen.TabStop = True 
txtByNum.TabStop = True 
txtByDen.TabStop = True 
Else 

fraFractionRange.Visible = False 
End If 

chkMixedNumbers.TabStop = True 

Case vtString 
fraString.ZOrder 
cmdVarlmport.Visible = True 
cmdVarExport.Visible = True 

Case vtUntyped 
fraUntyped.ZOrder 

End Select 

Dim intTablndex As Integer 
intTablndex = 4 

Call AddTab(chkIsIndependent, intTablndex) 

Call AddTab(txtFrom, intTablndex) 

Call AddTab(txtTo, intTablndex) 

Call AddTab(txtBy, intTablndex) 

Call AddTab(txtFromNum, intTablndex) 

Call AddTab(txtFroniDen, intTablndex) 

Call AddTab(txtToNum, intTablndex) 

Call AddTab(txtToDen, intTablndex) 

Call AddTab(txtByNum, intTablndex) 

Call AddTab(txtByDen, intTablndex) 

Call AddTab(chkTrailingZeros, intTablndex) 

Call AddTab(chkOnGrid, intTablndex) 

Call AddTab(chkMixedNumbers, intTablndex) 

End Sub 

' add a tab, if its active 

Private Sub AddTab(ByVal ctlC As Control, intlndex As Integer) 
IfctlC.TabStop Then 
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ctlC.Tablndex = intlndex 
intlndex = intlndex + 1 
End If 

End Sub 

Private Function ValidateFormQ As Boolean 

ValidateForm = False 

' check variable name length > 0 
If Len(txtVariableName) = 0 Then 

Call MsgBox(" Variable names must be 1 or more characters long/', _ 
vbExclamation, "Error") 

txtVariableName. SetFocus 

Exit Function 
End If 

'check first character for alpha 

If Asc(txtVariableName) < 65 Or Asc(txtVariableName) > 91 Then 

Call MsgBoxC* Variable names must begin in a letter", _ 
vbExclamation, "Error") 

txtVariableName. SetFocus 

Exit Function 
End If 

' check for unique variable name 
Dim blnUnique As Boolean 
blnUnique = True 

Select Case mbytAddEditFlag 

Case aeAdd 

blnUnique = mudtModel.Variables.UniqueName(txtVariableName) 
Case aeEdit 

blnUnique = mudtModel.Variables.UniqueName(txtVariableName, 1, mudtVar) 
End Select 

If blnUnique = False Then 

Call MsgBox("Variable name is already in use.", vbExclamation, "Error") 

txtVariableName. SetFocus 

Exit Function 
End If 
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* if integer or real, validate contents of From, To, By 
If cboVarType = "Integer" Or cboVarType = "Real" Then 
If Not ValidateRange Then 

Call MsgBox("Entries in From, To, and By must be either a number " 
"or a string variable containing a numeric value. " & _ 
"Expressions or math variables are not permitted.", _ 
vbExclamation, "Error") 
Exit Function 
End If 
End If 

ValidateForm = True 
End Function 

Private Function ValidateRangeQ As Boolean 

Dim conC As Control 
Dim colC As New Collection 
Dim udtV As Variable 
Dim udtVS As VarString 
Dim inti As Integer 
Dim blnOK As Boolean 

Call colC.Add(txtFrom) 
Call colC.Add(txtTo) 
Call colC.Add(txtBy) 

For Each conC In colC 
bhiOK = False 
If IsNumeric(conC) Then 

blnOK = True 
Else * see if the box contains a string variable 
For Each udtV In mudtModel. Variables 
If udtV.Typ = vtString Then 
Set udtVS = udtV 
If udtVSTsIndexed Then 

For intI = 1 To udtVS.Numlndices 

If conC = GetIndexedName(udtV.name, intI) Then 
blnOK = True 
Exit For 
End If 
Next intI 
Elself conC = udtV.name Then 
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blnOK = True 
End If 
End If 

IfblnOK Then 
5 Exit For 

End If 
Next udtV 
End If 

If Not blnOK Then 
10 VaUdateRange = False 

Exit Function 
End If 
Next conC 

1 5 ValidateRange = True 

End Function 

Private Sub ProcessEdit() 



2i! 



' Check to see if the type has changed 
If mudtType <> mudtOldType Then 



4^ With mlstListBox 

=1] * remove the old variable from the collection 

4^' Call mudtModel.Variables.Remove(Str(.ItemData(.ListIndex))) 

2^=^ * add the new variable 

Call AddVariable 

' update the index in the list box 
% .ItemData(.Listlndex) = mudtVar.index 

* replace the text in the list box 

.List(.Listlndex) = mudtVar.ScreenFormat 
n End With 



Else 

* update it with new data from form 
35 Select Case mudtType 

Case vtlnteger 

Call mudtVarInt.Update(txtVariableName, _ 
txtFrom, txtTo, txtBy, _ 
40 chklslndependent, chkChecksum) 

Case vtReal 

Call mudtVarReal.Update(txtVariableName, 
txtFrom, txtTo, txtBy, chklslndependent, _ 
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chkChecksum, chkTrailingZeros.Value, cboPrecision, chkOnGrid) 

Case vtFraction 

Call mudtVarFraction.Update(txtVariableName, _ 
txtFromNum, txtPromDen, txtToNum, txtToDen, _ 
txtByNum, txtByDen, chklslndependent, chkChecksum, _ 
chkMixedNumbers) 

Case vtString 

Dim inti As Integer 
Dim intI2 As Integer 
Dim colStr As Collection 
Dim udtSS As Substring 

mudtVar.name = txtVariableName 
mudtVar.Checksum = chkChecksum 
mudtVarString.IsIndexed = chklndexed 

' build a new collection of strings 
Set colStr = New Collection 
With IvwStrings 

For intI = 1 To (.Listltems.Count) 

Set udtSS = New Substring 

udtSS.Delimiter = mudtVarString.Delimiter 

Call udtSS.AddSubString(.ListItemsJtem(intI).Text) 

For intI2 = 1 To .ColumnHeaders.Count - 1 

Call udtSS.AddSubString(.ListItems.Item(intI).SubItems(intI2)) 

Next intI2 

Call colStr.Add(udtSS.StringValue) 
Next intI 
End With 

mudtVarString.StringCoUection = colStr 
End Select 

With mlstListBox 

' replace the text in the list box 

.List(.Listlndex) = mudtVar.ScreenFormat 
End With 

End If 

End Sub 

Private Sub ProcessAddQ 
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Call AddVariable 

With mlstListBox 

* Add the new variable to the variable list box 
Call .Addltem(mudtVar.ScreenFormat) 

* Set ItemData to index value of the variable object 
.IteniData(.ListCount - 1) = mudtVar.index 

' Check the check box 
.Selected(.ListCount - 1) = Trae 
End With 

End Sub 

Private Sub AddVariable() 

' Add the new variable 
Select Case mudtType 

Case vtlnteger 

Set mudtVar = mudtModel. Variables.AddInteger(txtVariableName, _ 
True, txtFrom, txtTo, txtBy, chklslndependent, _ 
chkChecksum) 

Case vtReal 

Set mudtVar = mudtModel.Variables.AddReal(txtVariableName, _ 
True, txtFrom, txtTo, txtBy, chklslndependent, _ 
chkChecksum, chkTrailingZeros.Value, cboPrecision, chkOnGrid) 

Case vtFraction 

Set mudtVar = mudtModel.Variables. AddFraction(txtVariableName, 
True, txtFromNum, txtFromDen, txtToNum, txtToDen, _ 
txtByNum, txtByDen, chklslndependent, chkChecksum, _ 
chkMixedNumbers) 

Case vtString 

Dim inti As Integer 

Dim intI2 As Integer 

Dim colStr As New Collection 

Dim udtSS As Substring 

With IvwStrings 

For intI = 1 To (.Listltems. Count) 
Set udtSS = New Substring 
udtSS.Delimiter = Chr(STRING_DELIMITER) 
udtSS.AddSubString (.Listltems.Item(intl).Text) 
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For intI2 = 1 To .ColumnHeaders. Count - 1 

Call udtSS.AddSubString(.ListItems.Item(intI).SubItems(intI2)) 
Next intI2 
Call colStr.Add(udtSS.StringValue) 
Next inti 
End With 

Set mudtVar = mudtModel.Variables. AddString(txtVariableName, True, _ 
chkChecksum, Chr(STRING_DELIMITER), chklndexed, colStr) 

Case vtUntyped 

Set mudtVar = mudtModel.Variables.AddUntyped(txtVariableName, True, 
chkChecksum) 

End Select 

End Sub 

Private Sub UpdateControlStatesQ 
Dim conC As Control 
On Error Resume Next 

' shut off all controls that have an enabled property 
For Each conC In Me 

If mudtModel.IsFrozen Then 
conC.Enabled = False 

Else 

conC.Enabled = True 
End If 
Next conC 

On Error GoTo 0 

' these stay on even if model is frozen 
cmdVarCancel.Enabled = True 
fraString.Enabled = True 
IvwStrings. Enabled = True 
cmdEdit.Enabled = True 
mnuStringEdit.Enabled = True 

' if model is frozen, change caption of edit button, menu to browse 
If mudtModel.IsFrozen Then 

cmdEdit.Caption = "Browse" 

mnuStringEdit.Caption = "Browse" 
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End If 



' turn export on if there's something to export 
cmdVarExport.Enabled = CBool(lvwStrings.ListItems. Count) 

' shut off "edit", "remove" buttons, menus if the Ustview is empty 
If IvwStrings.Listltems.Count = 0 Then 

mnuStringEdit.Enabled = False 

cmdEdit.Enabled = False 

mnuStringRemove. Enabled = False 

cmdRemove.Enabled - False 
End If 

End Sub 

' this is used to convert version 0.6 indexed strings to version 0.7 style 

Private Sub ConvertDelimiterQ 

Dim colStr As Collection 
Dim varS As Variant 

With mudtVarString 

Set colStr = .StringCoUection 

For Each varS In colStr 

varS = ReplaceAll(varS, .Delimiter, Chr(STRING_DELIMITER)) 

Next varS 
End With 

End Sub 

Private Sub LoadListViewQ 

Dim inti As Integer 
Dim varS As Variant 

With mudtVarString 
If chklndexed Then 
' build column headers 
For intI = 1 To .Numlndices - 1 

Call lvwStrings.ColumnHeaders,Add(, , _ 
Str(intl), IvwStrings.Width / 4) 
Next intI 
End If 

' fill in values 



VBSCA -250- 



For Each varS In .StringCoUection 

Call AddStrToListView(varS) 
Next varS 
End With 

End Sub 

Private Sub AddColToListView(ByVal colS As Collection) 

Dim IsiLI As Listltem 

Set IsiLI = IvwStrings.Listltems.AddG , "") 
Call UpdateListView(lsiLI, colS) 

End Sub 

Private Sub AddStrToListView(ByVal strS As String) 

Dim udtSS As New Substring 
Dim IsiLI As Listltem 
Dim inti As Integer 

Set IsiLI = lvwStrings.ListItems.Add(, , "") 
udtSS. Delimiter = Chr(STRING_DELIMITER) 
udtSS. String Value = strS 

Call UpdateListView(lsiLI, udtSS. StringCoUection) 
End Sub 

Private Sub UpdateListView(ByVal IsiLI As Listltem, ByVal colS As Collection) 

Dim intI As Integer 

Dim intW As Integer 

Dim strColHeading As String 

If chklndexed Then 

intW = 4 
Else 

intW= 1 
End If 

' expand the number of columns if there aren't enough 
For intI = IvwStrings.ColumnHeaders.Count To colS.Count - 1 
If chklndexed Then 
StrColHeading = Str(intl + 1) 
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Call lvwStrings.ColunmHeaders.Add(, , strColHeading, _ 
IvwStrings. Width / intW) 

Else 

strColHeading = " " 

Call lvwStrings.ColumnHeaders.Add(, , strColHeading) 
End If 
Next inti 

' plug in the values 

For intI - I To colS. Count 

Ifintl= 1 Then 

IsiLI = colS Jtem(intl) 

Else 

lsiLI.SubItems(intI - 1) = colS.Item(intl) 
End If 
Next intI 

' get rid of anything in the list view past colS. Count 
For intI = colS. Count + 1 To IvwStrings. ColumnHeaders. Count 
Ifintl> 1 Then 

lsiLI.SubItems(intI - 1) = "" 
Else 

IsiLI = 
End If 
Next intI 

Dim blnEmpty As Boolean 

' get rid of columns with all from right to left 
' stop when first column with any string > 0 length is encountered 
For intI = IvwStrings.ColumnHeaders.Count To 1 Step -1 
For Each IsiLI In IvwStrings. Listltems 
blnEmpty = True 
Ifintl> 1 Then 

If IsiLI. Subltems(intl - 1) <> Then 
blnEmpty - False 
Exit For 
End If 
ElseIflsiLIo""Then 
blnEmpty =^ False 
Exit For 
End If 
Next IsiLI 

If blnEmpty Then ^ 

Call IvwStrings. ColumnHeaders.Remove(intl) 
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Else 

Exit For 
End If 
Next inti 

Dim intI2 As Integer 

* get rid of rows with in all columns from the bottom up 
For intI2 = IvwStrings.Listltems. Count To 1 Step -1 
Set IsiLI = lvwStrings.ListItems.Item(intI2) 
For intI = 1 To IvwStrings.ColumnHeaders. Count 
blnEmpty = True 
Ifintl> 1 Then 

If lsiLLSubItems(intI - 1) o Then 
blnEmpty = False 
Exit For 
End If 
ElseIflsiLlo'"'Then 
blnEmpty = False 
Exit For 
End If 
Next intI 
If blnEmpty Then 

Call IvwStrings.Listltems. Remove(intI2) 
End If 
Next intI2 

End Sub 

Private Function GetSubStringCollection(ByVal IsiLI As Listltem) As Collection 

Dim colC As New Collection 
Dim intI As Integer 

Call colC.Add(lsiLI) 

For intI = 1 To IvwStrings.ColumnHeaders. Count - 1 

Call colC.Add(lsiLLSubItems(intI)) 
Next intI 

Set GetSubStringCoUection = colC 
End Function 



VBSCA -253- 



' Application.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 

DataSourceBehavior = 0 VbNone 

MTSTransactionMode =0 'Not AnMTS Object 
END 

Attribute VBName = "TCAApplication" 
Attribute VBGlobalNameSpace = False 
Attribute VB Creatable - True 
Attribute VBPredeclaredId = False 
Attribute VB_Exposed = False 

Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 
Option Explicit 



Public Sub Run() 

' Dim udtP As New Prolog 

' If udtP.StartProlog("hlp41ib.p4") = False Then 

' Call MsgBox("Prolog failure on startup", vbExclamation, "Error") 

' End If 

fhnTCA.Show 

End Sub 
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' CClones.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l Trae 
5 END 

Attribute VB_Name = "CClones" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

' enable i/o 

Private mudtFile As File 

'to hold collection 
15 Private mcolClones As Collection 

ji ' the sequence number appended to clone filenames 
01 Private mintSeqNum As Integer 

J~ ! 

^ 'is dirty 

Private mblnlsDirty As Boolean 

2#-'^ Private Sub Class InitializeO 

1^ 'creates the collection when this class is created 
pi Set mcolClones = New Collection 

p End Sub 

25 Private Sub Class_Terminate() 

'destroys collection when this class is terminated 
Set mcolClones = Nothing 

End Sub 

30 Public Property Get Item(vntIndexKey As Variant) As Clone 

'used when referencing an element in the collection 
'vntlndexKey contains either the Index or Key to the collection, 
'this is why it is declared as a Variant 
'Syntax: Set foo = xJtem(xyz) or Set foo = x.Item(5) 
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Set Item = mcolClones(vntlndexKey) 
End Property 

Public Property Get CountQ As Long 

'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x. Count 
Count = mcolClones. Count 

End Property 

Public Property Get NextSeqNum() As Integer 

mintSeqNum = mintSeqNum + 1 
NextSeqNum = mintSeqNum 

mblnlsDirty = True 

End Property 

Public Property Let SeqNum(ByVal intNewValue As Integer) 

mintSeqNum = intNewValue 

mblnlsDirty = True 
End Property 

Public Property Get SeqNumQ As Integer 

SeqNum = mintSeqNum 
End Property 

Public Property Get IsDirtyQ As Boolean 

Dim udt Clone As Clone 

' see if any collection members are dirty 
If Not mblnlsDirty Then 

For Each udtClone In mcolClones 
If udtClone.IsDirty Then 
mblnlsDirty = True 
Exit For 
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End If 
Next udtClone 
End If 

5 IsDirty = mblnlsDirty 

End Property 

Private Function NextlDQ As Long 

' creates a unique index to associate a clone and a listbox 
10 Static InglD As Long 

InglD = InglD + 1 
NextID = InglD 

15 End Function 

Q Public Function Add(ByVal strFN As String, _ 

Jj Optional ByVal blnAddSeqNum = False) As Clone 

Dim udtClone As New Clone 

2^ ' add the clone sequence number to the file name if blnAddSeqNum is True, 

"f.^ If blnAddSeqNum Then 

udtClone.FileName = left(strFN, Len(strFN) - 4) & _ 

U Trim(Str(NextSeqNum)) & ".doc" 

dh Else 

2|;j udtClone.FileName = ExtractFileName(strFN) 

P End If 

O udtClone.Index = NextID 

30 ' use index of the clone as the key 

Call mcolClones.Add(udtClone, Str(udtClone.Index)) 

Set Add = udtClone 

End Function 

35 Public Function AddObj(ByVal udtClone As Clone) As Clone 
udtClone.Index = NextID 
' use index of the clone as the key 
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20-;' 



Call mcolClones.Add(udtClone, Str(udtClone.Index)) 
Set AddObj = udtClone 
End Function 

Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
VntlndexKey contains either the Index or Key, which is why 
*it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolClones.Remove vntlndexKey 

mblnlsDirty = True 

End Sub 

Public Property Get NewEnum() As lUnknown 
Attribute NewEnum.VB_UserMemId = -4 

'this property allows you to enumerate 
'this collection with the For... Each syntax 
Set NewEnum = mcolClones. [_NewEnum] 

End Property 

Public Sub ClearQ 

' empties the collection class 

Set mcolClones = Nothing 



25 Set mcolClones = New Collection 

mblnlsDirty = True 
End Sub 

30 Public Sub ReadCollection(ByVal strFN As String, ByVal IngStartlndex As Long, 
ByVal IngEndlndex As Long) 

Set mudtFile = New File 

mudtFile.FileName = strFN 

Call mudtFile.ReadFile(Me, IngStartlndex, IngEndlndex) 
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Set mudtFile = Nothing 
End Sub 

Public Sub ReadObjectsO 

Dim udtClone As Clone 

On Error GoTo Beatit 

Do Until Err.Number o 0 

Set udtClone = New Clone 

Call udtClone.ReadObj ectData(mudtFile) 

udtClone. Index = NextID 

Call mcolClones.Add(udtClone, Str(udtClone.Index)) 

Loop 
Beatit: 

Exit Sub 
End Sub 

Public Function WriteCollection(ByVal strFN As String, _ 
ByVal InglndexPos As Long, ByVal IngSeekPos) As Long 

Set mudtFile = New File 

mudtFile.FileName = strFN 

WriteCoUection = mudtFile.WriteFile(Me, False, InglndexPos, IngSeekPos) 

Set mudtFile = Nothing 

mblnlsDirty = False 
End Function 
Public Sub WriteObjectsQ 

Dim udtClone As Clone 

For Each udtClone In mcolClones 
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Call udtClone.WriteObjectData(mudtFile) 
Next udtClone 



End Sub 



' CConstraints.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
END 

Attribute VB_Name = "CConstraints" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' enable i/o 

Private mudtFile As New File 

*local variable to hold collection 
Private mcolConstraint As Collection 

' is dirty 

Private mblnlsDirty As Boolean 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

Dim udtCon As Constraint 

For Each udtCon In mcolConstraint 
IfudtCon.IsDirty Then 
mblnlsDirty = True 
Exit For 
End If 
Next udtCon 

IsDirty = mblnlsDirty 

End Property 

Private Sub Class_Initialize() 
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'creates the collection when this class is created 
Set mcolConstraint = New Collection 

End Sub 

Private Sub Class_TemiinateO 

'destroys collection when this class is terminated 
Set mcolConstraint = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Constraint 

'used when referencing an element in the collection 

'vntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5) 

Set Item = mcolConstraint( vntlndexKey) 

End Property 

Public Property Get CountQ As Long 

'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x. Count 
Count = mcolConstraint.Count 

End Property 

Public Sub AddObject(udtCon As Constraint) 
' adds constraint objects directly to the collection 
udtCon. Index = NextID 

Call mcolConstraint. Add(udtCon, Str(udtCon.Index)) 
mblnlsDirty = True 
End Sub 

Public Function Add(By Val strConstraint As String, ByVal blnEnabled As Boolean, 
ByVal udtType As ConstraintType, ByVal strComment As String) As Constraint 

'create a new object 
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Dim objNewMember As Constraint 
Set objNewMember = New Constraint 

'set the properties passed into the method 
With objNewMember 
5 .ConstraintString = strConstraint 

.Enabled = blnEnabled 

.ConstraintType = udtType 

.Comment = strComment 

.Index = NextID 
10 ' add the new object to the collection 

Call mcolConstraint. Add(objNewMember, Str$(. Index)) 
End With 

'return the object created 
1 5 Set Add = objNewMember 

Set objNewMember = Nothing 

p mblnlsDirty = True 

01 End Function 

20p Public Sub Remove(vntIndexKey As Variant) 

"f! 'used when removing an element from the collection 

'vntlndexKey contains either the Index or Key, which is why 
i:. 'it is declared as a Variant 
ji 'Syntax: x.Remove(xyz) 
2^ mcolConstraint.Remove vntlndexKey 
U 

p mblnlsDirty = True 
End Sub 

30 Public Function NewEnumQ As lUnknown 
Attribute NewEnum. VB_UserMemId = -4 
Attribute NewEnum. VB_MemberFlags = "40" 

'this property allows you to enumerate 
'this collection with the For.. .Each syntax 
35 Set NewEnum = mcolConstraint. [_NewEnum] 

End Function 

Private Function NextlDQ As Long 
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* creates a unique index to associate a constraint and the constraint listbox(es) 
Static InglD As Long 

InglD = InglD + 1 
NextID = InglD 

End Function 

* returns true if strCon is already a constraint in the collection. Used 

* when importing constraints to make sure dups are not introduced. 
Public Function UniqueConstraint(ByVal strCon As String) As Boolean 

Dim udtCon As Constraint 

UniqueConstraint = True 

' Check for duplicate constraint 
For Each udtCon In mcolConstraint 

If StrCon = udtCon. ConstraintString Then 
UniqueConstraint = False 
Exit For 
End If 
Next udtCon 

End Function 

Public Sub ReadCollection(By Val strFN As String, ByVal IngStartlndex As Long, 
ByVal IngEndlndex As Long) 

mudtFile.FileName = strFN 

Call mudtFile.ReadFile(Me, IngStartlndex, IngEndlndex) 
End Sub 

Public Sub ReadObjectsQ 

Dim udtCon As Constraint 

On Error GoTo Beatit 

Do Until Err.Number o 0 

Set udtCon = New Constraint 

Call udtCon.ReadObjectData(mudtFile) 

udtCon.Index = NextID 
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Call mcolConstraint.Add(udtCon, Str(udtCon.Index)) 

Loop 
Beatit: 

Exit Sub 
End Sub 

Public Function WriteCollection(ByVal strFN As String, _ 
ByVal InglndexPos As Long, ByVal IngSeekPos) As Long 

mudtFile.FileName = strFN 

WriteCollection = mudtFile.WriteFile(Me, False, InglndexPos, IngSeekPos) 

mblnlsDirty = False 
End Function 
Public Sub WriteObjectsO 

Dim udtCon As Constraint 

For Each udtCon In mcolConstraint 

Call udtCon. WriteObjectData(mudtFile) 

Next udtCon 
End Sub 

Public Sub Clear(ByVal udtType As VariableType) 

* empties the collection class of all constraints of type udtType 

Dim udtCon As Constraint 

For Each udtCon In mcolConstraint 

If udtCon. ConstraintType = udtType Then 

Call mcolConstraint.Remove(Str(udtCon.Index)) 
End If 

Next udtCon 
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End Sub 



' returns true if an enabled string variable name was used 
' in any enabled constraint 

Public Function String VarNamesUsed(ByVal udtCVar As CVariables) As Boolean 

' First create a collection of all enabled constraint strings 

Dim udtCon As Constraint 

Dim colStrings As New Collection 

For Each udtCon In mcolConstraint 

If udtCon.Enabled Then 

colStrings.Add udtCon. Constraints tring 

End If 
Next udtCon 

* create a variable collection with variable names sorted in length 

* from longest to shortest 
Dim udtSCVar As CVariables 

Set udtSCVar = udtCVar.SortVarNamesByLength 

' nibble variable names out of the string collection, using enabled 
' variable names sorted in length from longest to shortest 
Dim vntS As Variant 
Dim vntT As Variant 
Dim vntStart As Variant 
Dim udtVar As Variable 

For Each vntS In colStrings 
For Each udtVar In udtSCVar 
If udtVar.Enabled Then 

vntStart = InStr(l, vntS, udtVar.Name) 
If vntStart Then 

If udtVar.Typ = vtString Then 
StringVarNamesUsed = True 
Exit Function 
Else 

vntT = vntS 

vntS = left(vntT, vntStart - 1) & _ 
right(vntT, Len(vntT) - vntStart - _ 
Len(udtVar.Name) + 1) 
End If 
End If 
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End If 
Next udtVar 
Next vntS 

StringVarNamesUsed = False 



End Function 



' Checksum.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 
END 

Attribute VB_Name = "Checksum" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mcolStr As Collection 

Private Sub Class_Initialize() 

Set mcolStr = New Collection 

End Sub 

Public Sub AddValue(ByVal strNewValue As String) 

Call mcolStr.Add(strNewValue) 
End Sub 

Public Function ComputeCSQ As Double 

Dim n As Integer 
Dim dblCS As Double 
Dim dblSum As Double 
Dim varStr As Variant 
Dim cntr As Integer 
Dim dblT As Double 

cntr = 1 

' On Error GoTo Overflow 

For Each varStr In mcolStr 
dblSum = 0 
n = Len( varStr) 
While n > 0 

dblSum = Asc(Mid(varStr, n, 1)) * n + dblSum 
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n = n - 1 
Wend 

dblCS = dblSum * cntr + dblCS 
cntr = cntr + 1 
Next varStr 

'Overflow: 

ComputeCS - dblCS 

Exit Function 



End Function 



' Clone. els 

VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
END 

Attribute VB_Name = "Clone" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

* file name (without path) of this clone 
Private mstrFN As String 

' hold document handle 

Private mdocCloneDoc As Document 

' checksum of variables 

Private mdblChecksum As Double 

' index 

Private mlnglndex As Long 
' is dirty 

Private mblnlsDirty As Boolean 

' has been routed to ICS 
Private mbytlsRouted As Byte 

' program 

Private mudtProgram As Program 
' domain 

Private mudtDomain As Domain 

* the batch id 

Private mstrBatchID As String 
' the target template 

Private udtDeliveryMode As DeliveryMode 



' pure or real model 

Private mudtNature As Nature 

' TDer's estimate of difficulty (1-5) 
Private mbytTDEstimate As Byte 

' difficulty has been calculated 

Private mbytlsDifficultyCalculated As Byte 

* the key 

Private mstrKey As String 
' the item type 

Private mudtltemType As ItemType 

Public Enum Domain 

doArithmetic = 0 

doAlgebra = 1 

doDataAnalysis = 2 

doGeometry = 3 
End Enum 

Public Enum Nature 

naPure = 0 

naReal = 1 
End Enum 

' difficulty estimate 

Private mudtDE As DifficultyEstimate 
Private Sub Class_Initialize() 

mblnlsDirty = False 
End Sub 

Public Property Get FileNameQ As String 

FileName = mstrFN 
End Property 

Public Property Let FileName(ByVal strNewValue As String) 
If mstrFN o strNev^Value Then 
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mstrFN = strNewValue 
mblnlsDirty = True 
End If 

End Property 

Public Property Get CloneDocQ As Document 

Set CloneDoc = mdocCloneDoc 
End Property 

Public Property Let CloneDoc(ByVal docNewValue As Document) 

Set mdocCloneDoc = docNewValue 
End Property 

Public Property Get ChecksumQ As Double 

Checksum = mdblChecksum 
End Property 

Public Property Let Checksum(ByVal dblNewValue As Double) 

If mdblChecksum o dblNewValue Then 

mdblChecksum = dblNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get IndexQ As Long 

Index = mlnglndex 
End Property 

Public Property Let Index(ByVal IngNewValue As Long) 

If mlnglndex o IngNewValue Then 

mlnglndex = IngNewValue 

mblnlsDirty = True 
End If 
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End Property 

Public Property Get IsDirtyQ As Boolean 
IsDirty = False 

5 

If IsDifficultyCalculated Then ' don*t check DE if difficultly hasn*t been calculated! 
If mblnlsDirty Or mudtDE.IsDirty Then 

IsDirty = True 
End If 
10 Else 

If mblnlsDirty Then 

IsDirty = True 
End If 
End If 

15 

End Property 

Public Property Get IsRoutedQ As Byte 

Ui IsRouted = mbytlsRouted 

2(23 End Property 

^fl Public Property Let IsRouted(ByVal bytNewValue As Byte) 

^ If mbytlsRouted o bytNewValue Then 

2f mbytlsRouted = bytNewValue 

Tl mblnlsDirty = True 

2$^ End If 

End Property 

Public Property Get Program() As Program 

Program = mudtProgram 
End Property 

30 Public Property Let Program(ByVal udtNewValue As Program) 

If mudtProgram o udtNewValue Then 
mudtProgram = udtNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Get DomainQ As Domain 

Domain = mudtDomain 
End Property 

Public Property Let Domain(ByVal udtNewValue As Domain) 

If mudtDomain o udtNewValue Then 

mudtDomain = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get IsDifficultyCalculatedQ As Byte 

IsDifficultyCalculated = mbytlsDifficultyCalculated 
End Property 

Public Property Let IsDifficultyCalculated(ByVal bytNewValue As Byte) 

If mbytlsDifficultyCalculated o bytNewValue Then 

mbytlsDifficultyCalculated = bytNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get TDEstimateQ As Byte 

TDEstimate = mbytTDEstimate 
End Property 

Public Property Let TDEstimate(ByVal bytNewValue As Byte) 

If mbytTDEstimate o bytNewValue Then 
mbytTDEstimate = bytNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Get BatchlDQ As String 

BatchID - mstrBatchID 
End Property 

Public Property Let BatchID(ByVal strNewValue As String) 

If mstrBatcMD <> strNewValue Then 

mstrBatchID = strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get Key() As String 

Key = mstrKey 
End Property 

Public Property Let Key(ByVal strNewValue As String) 

If mstrKey o strNewValue Then 

mstrKey = strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get ItemTypeQ As ItemType 

ItemType = mudtltemType 
End Property 

Public Property Let ItemType(ByVal udtNewValue As ItemType) 

If mudtltemType o udtNewValue Then 
mudtltemType = udtNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Get DeliveryMode() As DeliveryMode 

DeliveryMode = udtDeliveryMode 
End Property 

Public Property Let DeliveryMode(ByVal udtNewValue As DeliveryMode) 

If udtDeliveryMode o udtNewValue Then 

udtDeliveryMode = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get Nature() As Nature 

Nature = mudtNature 
End Property 

Public Property Let Nature(ByVal udtNewValue As Nature) 

If mudtNature o udtNewValue Then 

mudtNature = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get DiffEstQ As DifficultyEstimate 

Set DiffEst = mudtDE 
End Property 

Public Property Let Difffist(ByVal udtNewValue As DifficultyEstimate) 

Set mudtDE = udtNewValue 
mblnlsDirty = True 
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End Property 

Public Sub OpenDoc(ByVal udtWord As MSWord, ByVal strPath As String) 

Dim udtDS As New DocStatus 

If udtDS.IsOpen(mstrFN) = False Then 
Set mdocCloneDoc = _ 
udtWord.WordApp.Documents.Open(FileName:=strPath & mstrFN) 
End If 

mdocCloneDoc. Activate 
End Sub 

Public Sub CloseDocQ 
Dim udtDS As New DocStatus 

If udtDS.IsOpen(mstrFN) Then 

Call mdocCloneDoc.Close(wdSaveChanges) ' save changes 

Set mdocCloneDoc = Nothing 
End If 

End Sub 

Public Sub ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' returns the version stamp 
Call udtFile.ReadField(vField) 
FileName = ExtractFileName(vField) 

Call udtFile.ReadField(vField) 

Key = ExtractFileName(vField) 

Call udtFile.ReadField(vField) 

ItemType = ExtractFileName(vField) 

Call udtFile.ReadField(vField) 

Program = vField 

Call udtFile.ReadField(vField) 

Domain = vField 

Call udtFile.ReadField(vField) 

BatchID = vField 

Call udtFile.ReadField(vField) 
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DeliveryMode = vField 
Call udtFile.ReadField(vField) 
Nature = vField 
Call udtFile.ReadField(vField) 
TDEstimate = vField 
Call udtFile.ReadField(vField) 
IsRouted = vField 
Call udtFile.ReadField(vField) 
IsDifficultyCalculated = vField 
Set mudtDE = Nothing 
If IsDifficultyCalculated Then 
Select Case Program 
Case prGRE 

Set mudtDE = New GREDifficultyEstimate 
Case prGMAT 

Set mudtDE = New GMATDifficultyEstimate 
End Select 

CallmudtDE.ReadObjectData(udtFile) 
End If 

End Sub 

Public Sub WriteObjectData(udtFile As File) 

Call udtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(ExtractFileName(mstrFN)) 

Call udtFile.WriteField(Key) 

Call udtFile.WriteField(ItemType) 

Call udtFile.WriteField(Program) 

Call udtFile.WriteField(Domain) 

Call udtFile.WriteField(BatchID) 

Call udtFile.WriteField(DeliveryMode) 

Call udtFile.WriteField(Nature) 

Call udtFile.WriteField(TDEstimate) 

Call udtFile.WriteField(IsRouted) 

CalludtFile.WriteField(IsDifficultyCalculated) 

If IsDifficultyCalculated Then 

Call mudtDE. WriteObjectData(udtFile) 
End If 

mblnlsDirty = False 
End Sub 
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' CModels.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l 'True 
5 END 

Attribute VB_Name = "CModels" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

'to hold collection 

Private mcolModels As Collection 

Private Sub Class_Initialize() 

1S=^ 'creates the collection when this class is created 

Ith Set mcolModels = New Collection 

01 

Ul End Sub 

Jl Private Sub Class_Terminate() 

2§3 'destroys collection when this class is terminated 

Set mcolModels = Nothing 

2f End Sub 

h Public Property Get Item(vntIndexKey As Variant) As Model 

25 'used when referencing an element in the collection 

'vntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo = x Jtem(xyz) or Set foo = x.Item(5) 

Set Item = mcolModels(vntlndexKey) 

30 

End Property 

Public Property Get CountQ As Long 

'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x.Count 
35 Count = mcolModels. Count 
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End Property 

Public Sub AddObject(udtMod As Model) 

' adds model objects directly to the collection. Use the file 
'key. 

Call mcolModels.Add(udtMod, Str(udtMod.FileName)) 
End Sub 

Public Function AddNew(ByVal strFN As String, _ 
ByVal udtltemType As ItemType) As Model 

Dim udtMod As Model 
Dim udtSMC As SMCModel 
Dim udtQC As QCModel 
Dim udtDS As DSModel 

Select Case udtltemType 

Case ptStandardMC 
Set udtSMC = New SMCModel 
Set udtMod = udtSMC 

Case ptQuantComp 
Set udtQC = New QCModel 
Set udtMod = udtQC 

Case ptDataSuff 

Set udtDS = New DSModel 
Set udtMod = udtDS 

End Select 

' file name has full path 
udtMod.FileName = strFN 
udtMod.IsFrozen = False 

' strip path firom key 

Call mcolModels.Add(udtMod, ExtractFileName(strFN)) 
Set AddNew = udtMod 
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End Function 

Public Function AddExisting(ByVal strFN As String, 
ByVal udtltemType As ItemType) As Model 

Dim udtMod As New Model 
5 Dim udtSMC As SMCModel 

Dim udtQC As QCModel 
Dim udtDS As DSModel 

Select Case udtltemType 

10 Case ptStandardMC 

Set udtSMC = New SMCModel 
Set udtMod = udtSMC 

Case ptQuantComp 
1 5 Set udtQC = New QCModel 

Set udtMod = udtQC 



y J 



Case ptDataSuff 
yi Set udtDS = New DSModel 

im Set udtMod = udtDS 



22: 



End Select 

' file name has full path 
udtMod.FileName = strFN 
Call udtMod.ReadModel 

' strip path fi'om key 

Call mcolModels.Add(udtMod, ExtractFileName(strFN)) 



Set AddExisting = udtMod 

30 End Function 

Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element fi'om the collection 
'vntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
35 'Syntax: x.Remove(xyz) 

mcolModels.Remove vntlndexKey 

End Sub 
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Public Property Get NewEnumQ As lUnknown 
Attribute NewEnum.VB_UserMemId = -4 
Attribute NewEnurn.VB_MemberFlags = "40" 

'this property allows you to enumerate 
*this collection with the For... Each syntax 
Set NewEnum = mcolModels.[_NewEnum] 

End Property 

Public Sub ClearQ 

* empties the collection class 

Set mcolModels = Nothing 

Set mcolModels = New Collection 



End Sub 



* Constraint.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser 0 Talse 
5 Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 

DataSourceBehavior = 0 VbNone 

MTSTransactionMode = 0 'NotAnMTSObject 
END 

1 0 Attribute VB_Name = "Constraint" 

Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
1 5 Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "MemberO" ,"CloningConstraint" 
Attribute VB_Ext_KEY = "Member 1" /'DifficultyConstraint" 
Attribute VB_Ext_KEY = "Member2" ,"MathConstraint" 
Attribute VB_Ext__KEY = "MemberS" ,"VariableDefinition" 
2m Attribute VB_Ext_KEY = "Top_Level" /'Yes" 
Ul Option Explicit 

^ ' current version of data produced by this class 
4j Const mintVERSIONSTAMP As Integer = 1 

L Private mudtType As VariableType 
25? Private mstrConstraint As String 
Private mstrComment As String 
Tl Private mlnglndex As Long 
^==1 Private mblnEnabled As Boolean 
Q Private mblnlsDirty As Boolean 

30 ' These numbers correspond to the indices of the constraint listboxes in frmTCA 
Public Enum ConstraintType 

ctVariation = 0 

ctDistractor = 1 
End Enum 

35 Public Property Get Constraints tring() As String 
ConstraintString = mstrConstraint 
End Property 
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Public Property Let ConstraintString(ByVal strNewValue As String) 

If mstrConstraint o strNewValue Then 

mstrConstraint = strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get CommentQ As String 

Comment = mstrComment 
End Property 

Public Property Let Coniment(ByVal strNewValue As String) 

If mstrComment o strNewValue Then 

mstrComment = strNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get ConstraintTypeQ As ConstraintType 

ConstraintType = mudtType 
End Property 

Public Property Let ConstraintType(ByVal udtNewValue As ConstraintType) 

If mudtType o udtNewValue Then 

mudtType = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get indexQ As Long 

index = mlnglndex 
End Property 
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Public Property Let index(ByVal IngNewValue As Long) 

mlnglndex = IngNewValue 
End Property 

Public Property Get EnabledQ As Boolean 

Enabled = mblnEnabled 
End Property 

Public Property Let Enabled(ByVal blnNewValue As Boolean) 

If mblnEnabled <> blnNewValue Then 

mblnEnabled = blnNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

IsDirty = mblnlsDirty 
End Property 

Public Sub Update(ByVal strConstraint As String, ByVal udtType As ConstraintType, 
ByVal strComment As String) 

ConstraintString = strConstraint 
ConstraintType - udtType 
Comment = strComment 

End Sub 

Public Sub ReadObjectData(udtFile As File) 
Dim vField As Variant 
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Call udtFile.ReadField(vField) ' read version stamp 
Call udtFile.ReadField(vField) 
ConstraintType = vField 

Call udtFile.ReadField(vField) 
Enabled = vField 

Call udtFile.ReadField(vField) 
ConstraintString = vField 

Call udtFile.ReadField(vField) 
Comment = vField 

End Sub 

Public Sub WriteObjectData(udtFile As File) 

Call udtFile.WriteField(mintVERSIONSTAMP) 
CalludtFile.WriteField(ConstraintType) 
Call udtFile.WriteField(Enabled) 
CalludtFile.WriteField(ConstraintString) 
Call udtFile.WriteField(Comment) 

mblnlsDirty = False 

End Sub 

' makes a copy of this object 

Public Function CopyQ As Constraint 

Dim udtC As New Constraint 

udtC. Enabled = Enabled 

udtC. index = index 

udtC.IsDirty = IsDirty 

udtC. ConstraintType = ConstraintType 

udtC. ConstraintString = ConstraintString 

udtC. Comment = Comment 

Set Copy = udtC 

End Function 
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' ConstraintSolver.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior = 0 VbNone 

MTSTransactionMode =0 'NotAnMTSObject 
END 

Attribute VB_Name = "ConstraintSolver" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mcolVs As Collection 
Private mcolVsSave As Collection 
Private mcolCs As Collection 
Private mcolCsSave As Collection 
Private mcolValues As Collection 
Private mbytDiffWeight As Byte 
Private mdblChecksum As Double 
Private mintlndex As Integer 

Private WithEvents mv^udtP As Prolog 
Attribute mwudtP.VB_VarHelpID = -1 
Private mlngRet As Long 

Private mblnProloglsRunning As Boolean 

Public Enum SolveRequester 

srTest = 0 

srGenerate = 1 
End Enum 

Public Enum SolveRetum 

srNoSolutions = 0 

srSuccess = 1 

srProlog Aborted = -1 

srPrologError = -2 
End Enum 

Private mudtSolveRequester As SolveRequester 
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Private Sub Class_Initialize() 

Set mcolVs = New Collection 
Set mcolVsSave = New Collection 
Set mcolCs = New Collection 
Set mcolCsSave = New Collection 
Set mcolValues = New Collection 

End Sub 

Private Sub Class_Terminate() 

• Kill Prolog 

Set mwudtP = Nothing 

End Sub 

Public Property Let Prolog(ByVal udtNewValue As Prolog) 

Set mwudtP = udtNewValue 
End Property 

Public Property Let DiffWeight(ByVal bytNewValue As Byte) 

mbytDiffWeight = bytNewValue 
End Property 

Public Sub AddVariable(ByVal udtNewValue As Variable) 

If udtNewValue.Enabled Then 

Call mcolVs.Add(udtNewValue.Copy) ' uses a copy of the variable 

Call mcolVsSave.Add(udtNewValue.Copy) 
End If 

End Sub 

Public Sub AddConstraint(ByVal udtNewValue As Constraint) 

If udtNewValue.Enabled Then 

Call mcolCs.Add(udtNewValue.Copy) ' uses a copy of the constraint 

Call mcolCsSave.Add(udtNewValue.Copy) ' 
End If 
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End Sub 



Public Function GetNextValue(strVarName As String, _ 
strValue As String) As Boolean 

Dim udtVal As Value 

If mintlndex <= mcolValues.Count Then 
Set udtVal = mcol Values. Item(mintlndex) 
strVarName = udtVal.VariableName 
strValue = udtVal. Value 

' if the value is replace with so Word doesn't choke 
If StrValue - Then strValue = 
mintlndex = mintlndex + 1 
GetNextValue = True 
Else 

GetNextValue = False 
End If 

End Function 

Public Sub ResetValuelndexQ 

mintlndex = 1 
End Sub 

Public Property Get Checksum() 
Checksum = mdblChecksum 
End Property 

PubUc Function Solve(ByVal udtSolveRequester As SolveRequester) As SolveRetum 

Dim udtVal As Value 
Dim udtC As Constraint 
Dim udtV As Variable 
Dim udtVS As VarString 
Dim udtSS As StringSolver 

mudtSolveRequester = udtSolveRequester 

Set mcol Values = New Collection 
mintlndex = 1 
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CreateValueCoUection 

If mcolValues.Count = 0 Then 

Solve = srNoSolutions 

Exit Function 
End If 

' solve all string variables 
For Each udtV In mcolVs 
If udtV.Typ = vtString Then 
Set udtVS = udtV 

' if this variable has no strings, error 

If udtVS.StringCollection.Count = 0 Then 

Solve = srNoSolutions 

Exit Function 
End If 

Set udtSS - New StringSolver 
udtSS.StringVariable = udtVS 
Call LoadStringValues(udtVS, udtSS) 
End If 
Next udtV 

' resolve any nested values for all string variable names 
ResolveNestedStrings 

' resolve string variable names embedded in math variable ranges 
ResolveStringsInMathVariables 

' resolve string variable names embedded in constraints 
ResolveConstraints 

* set the difference w^eight (difference between variants) 
mwudtP.DiffWeight = mbytDiffWeight 

Dim blnMathToSolve As Boolean 

' add non-string variables to prolog via the value object collection 
For Each udtVal In mcolValues 

If Not udtVal.VariableType = vtString Then 
Call mwudtP.AddVariable(udtValPrologString) 
blnMathToSolve = True 
End If 
Next udtVal 
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' add all constraints 

For Each udtC In mcolCs 

Call mwudtP.AddConstraint(udtC.ConstraintString) 

blnMathToSolve = True 
Next udtC 

' call prolog if there are math constraints, error if no solution found 
If blnMathToSolve Then 

* get rid of the kill file if it exists 
DestroyKillFile 
mblnProloglsRunning = True 

* runs async, notifies this class when it's done via the Finished event 
mwudtP.SolveConstraintsRandomly 

If udtSolveRequester = srTest Then 

fimProlog. Caption = "Testing constraints" 

fimProlog.lblProlog.Caption = "Click Abort to terminate this test." 

frmProlog.Show vbModal 
Else 

Do 

DoEvents 

Loop While mblnProloglsRunning 
End If 

If frmProlog. Abort Then 

' create the kill file 

CreateKillFile 

Solve = srPrologAborted 

Exit Function 
End If 

* not aborted 
Select Case mlngRet 

Case Is < 0 

Solve - srPrologError 

Call MsgBox("Prolog error: " & Str(mlngRet), vbExclamation, "Error") 
Exit Function 
CaseO 

Solve = srNoSolutions 
Exit Function 
End Select 
End If 

' load up values fi"om Prolog 
For Each udtVal In mcolValues 

If Not udtVal.VariableType = vtString Then 

udtVal. Value = mwudtP.Value(udtVal.VariableName) 

End If 
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Next udtVal 

' resolve string values that are math variable names 
ResolveMathVariablesInStrings 

Dim udtChecksum As New Checksum 

' compute the checksum of values 
For Each udtVal In mcolValues 

If udtVal. Checksum Then 

Call udtChecksum.AddValue(udtVaL Value) 

End If 
Next udtVal 

mdblChecksum = udtChecksum. ComputeCS 
Solve = srSuccess 

' restore the variable and constraint collections their original states, 
' as substitutions may have contaminated them. 
Set mcolVs = New Collection 
Set mcolCs = New Collection 

For Each udtV In mcolVsSave 

Call mcolVs.Add(udtV.Copy) 
Next udtV 

For Each udtC In mcolCsSave 

Call mcolCs.Add(udtC.Copy) 
Next udtC 

End Function 

' this event raised in Prolog class 

Private Sub mwudtP_Finished(ByVal IngRet As Long) 

mblnProloglsRunning = False 
mlngRet = IngRet 

' kill the form if this is a test 

If mudtSolveRequester = srTest Then 

frmProlog.Kill 
End If 

End Sub 
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Private Sub CreateValueCollectionQ 

Dim inti As Integer 
Dim udtV As Variable 
Dim udtVS As VarString 
Dim udtVal As Value 

For Each udtV In mcolVs 
If udtV.Typ = vtString Then 
Set udtVS = udtV 
If udtVS.IsIndexed Then 

For intI = udtVS.Numlndices To 1 Step -1 
Set udtVal = New Value 

udtVaLVariableName = GetIndexedName(udtV.name, 
udtVal.VariableType = udtV.Typ 
udtVal. Checksum = udtV. Checksum 
udtVal.PrologString = udtV.PrologFormat 
Call mcolValues.Add(udtVal, udtVal.VariableName) 
Next intI 
Else 

Set udtVal = New Value 
udtVal.VariableName = udtV.name 
udtVal.VariableType = udtV.Typ 
udtVal. Checksum = udtV. Checksum 
udtVal.PrologString - udtV.PrologFormat 
Call mcolValues.Add(udtVal, udtVal.VariableName) 
End If 
Else 

Set udtVal = New Value 
udtVal.VariableName = udtV.name 
udtVal.VariableType = udtV.Typ 
udtVal.Checksum = udtV.Checksum 
udtVal.PrologString = udtV.PrologFormat 
Call mcolValues. Add(udtVal, udtVal.VariableName) 
End If 
Next udtV 

End Sub 

Private Sub LoadStringValues(ByVal udtV As Variable, _ 
ByVal udtSS As StringSolver) 

Dim intI As Integer 
Dim varS As Variant 
Dim strVN As String 
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Dim udtVal As Value 
Dim udtVS As VarString 

Set udtVS = udtV 

' get the value or values (if indexed) 
If udtVS.IsIndexed Then 
inti = 1 

For Each varS In udtSS. Random ValueCollection 

strVN = GetIndexedName(udtV.name, intI) 

Set udtVal = mcolValues.Item(strVN) 

udtVal.Value = varS 

intI = intI + 1 
Next varS 
Else 

Set udtVal = mcolValues Jtem(udtV.name) 
udtVal.Value = udtSS.RandomValueCollection(l) 
End If 

End Sub 

Private Sub ResolveNestedStringsQ 

Dim blnContinue As Boolean 
Dim udtVal As Value 

Do 

blnContinue = False 

For Each udtVal In mcolValues 

If udtVal. VariableType = vtString Then 

If ResolveString(udtVaL VariableName) Then 

blnContinue = True 
End If 
End If 
Next udtVal 
Loop Until blnContinue = False 

End Sub 

Private Function ResolveString(ByVal strVN As String) As Boolean 

Dim udtVal As Value 
Dim udtVal2 As Value 
Dim strT As String 
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ResolveString = False 



For Each udtVal In mcolValues 

If udtVal.VariableType = vtString Then 
Set udtVal2 = mcolValues.Item(strVN) 
strT = ReplaceAll(udtVaL Value, strVN, udtVal2. Value) 
If strT o udtVal. Value Then 
udtVal.Value = strT 
ResolveString = True 
End If 
End If 
Next udtVal 

End Function 

Private Sub ResolveStringsInMathVariablesQ 

Dim udtVal As Value 
Dim udtVal2 As Value 

For Each udtVal In mcolValues 

If udtVal.VariableType = vtString Then 
For Each udtVal2 In mcolValues 

If Not udtVal2.VariableType = vtString Then 

udtVal2.PrologString = ReplaceAll(udtVal2.PrologString, 
udtVal.VariableName, udtVal.Value) 
End If 
Next udtVal2 
End If 
Next udtVal 

End Sub 

Private Sub ResolveConstraintsQ 

Dim udtC As Constraint 
Dim udtVal As Value 



For Each udtVal In mcolValues 

If udtVal.VariableType = vtString Then 
For Each udtC In mcolCs 

udtC. Constraints tring = Replace All(udtC. Constraint String, 
udtVal.VariableName, udtVal.Value) 
Next udtC 
End If 
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Next udtVal 



End Sub 

Private Sub ResolveMathVariablesInStrings() 

Dim udtVal As Value 
Dim udtVal2 As Value 

For Each udtVal In mcolValues 
If udtVal. VariableType = vtString Then 
For Each udtVal2 In mcolValues 
If Not udtVal2.VariableType = vtString Then 
udtVal.Value = ReplaceAll(udtVal. Value, udtVal2.VariableName, 
udtVal2.Value) 
End If 
Next udtVal2 
End If 
Next udtVal 

End Sub 



' CVariables.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l 'True 
END 

Attribute VB_Name = "C Variables" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 

Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "Collection" /'Variable" 
Attribute VB_Ext_KEY = "MemberO" ."Variable" 
Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 
Option Explicit 

' enable i/o 

Private mudtFile As File 
'to hold collection 

Private mcolVariable As Collection 
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' is dirty 

Private mblnlsDirty As Boolean 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
5 End Property 

Public Property Get IsDirtyQ As Boolean 

Dim udtVar As Variable 

For Each udtVar In mcolVariable 
1 0 If udtVar.IsDirty Then 

mblnlsDirty = True 
Exit For 
End If 
Next udtVar 

is 

1 §1 IsDirty = mblnlsDirty 

:|S End Property 

4« Private Sub Class_Initialize() 

Z,^ ^creates the collection when this class is created 

2fc Set mcolVariable = New Collection 



Set mudtFile = New File 

f 'l End Sub 

25 Private Sub Class_Terminate() 

'destroys collection when this class is terminated 
Set mcolVariable = Nothing 

'destroys the File object 
30 Set mudtFile = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Variable 
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'used when referencing an element in the collection 

VntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5) 

Set Item = mcolVariable(vntlndexKey) 

End Property 

Public Property Get CountQ As Long 

'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x. Count 
Count = mcolVariable.Count 

End Property 

Public Sub AddObject(udtVar As Variable) 
' adds variable objects directly to the collection 
udtVar.Index = NextID 

Call mcolVariable.Add(udtVar, Str(udtVar,Index)) 
End Sub 

Public Function AddInteger(ByVal strName As String, ByVal blnEnabled As Boolean, 
ByVal strFrom As String, ByVal strTo As String, ByVal strBy As String, _ 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean) As Variable 

'create anew object 

Dim udtVar As Variable 

Dim udtVarlnteger As New Varlnteger 

Set udtVar = udtVarlnteger 

'set the properties passed into the method 
With udtVar 

.Typ = vtlnteger 

.Name = strName 

.Enabled = blnEnabled 

.Index = NextID 

.Checksum = blnChecksum 
End With 

With udtVarlnteger 
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.From = strFrom 
.Too = strTo 
.By = strBy 

.Islndependent = blnlslndependent 
End With 

' add the new object to the collection 
Call mcolVariable.Add(udtVarInteger, Str(udtVar.Index)) 

'return the object created 

Set Addlnteger = udtVarlnteger 

End Function 

Public Function AddReal(ByVal strName As String, ByVal blnEnabled As Boolean, 
ByVal StrFrom As String, ByVal strTo As String, ByVal strBy As String, _ 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, _ 
ByVal blnTraihngZeros As Boolean, _ 

ByVal strPrecision As String, ByVal blnOnGrid As Boolean) As Variable 

'create anew object 

Dim udtVar As Variable 

Dim udtVarReal As New VarReal 

Set udtVar - udtVarReal 

'set the properties passed into the method 
With udtVar 

.Typ = vtReal 

.Name = strName 

.Enabled = blnEnabled 

.Index NextID 

.Checksum = blnChecksum 
End With 

With udtVarReal 
.From = StrFrom 
.Too = StrTo 
.By = StrBy 

.Islndependent = blnlslndependent 
.TraiUngZeros = blnTrailingZeros 
.Precision = strPrecision 
.IsOnGrid = blnOnGrid 
End With 
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' add the new object to the collection 

Call mcolVariable.Add(udtVarReal, Str(udtVar.Index)) 

Vetum the object created 
Set AddReal = udtVarReal 

End Function 

Public Function AddFraction(ByVal strName As String, ByVal blnEnabled As Boolean, 
ByVal strFromNum As String, ByVal strFromDen As String, _ 
ByVal strToNum As String, ByVal strToDen As String, _ 
ByVal strByNum As String, ByVal strByDen As String, _ 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, _ 
ByVal blnMixedNumbers As Boolean) As Variable 

'create a new object 

Dim udtVar As Variable 

Dim udtVarFraction As New VarFraction 

Set udtVar = udtVarFraction 

'set the properties passed into the method 
With udtVar 

.Typ = vtFraction 

.Name strName 

.Enabled = blnEnabled 

.Index NextID 

.Checksum = blnChecksum 
End With 

With udtVarFraction 

.FromNumerator = strFromNum 

.FromDenominator = strFromDen 

.ToNumerator = strToNum 

.ToDenominator = strToDen 

.ByNumerator = strByNum 

.ByDenominator = strByDen 

.Islndependent = blnlslndependent 

.MixedNumbers = blnMixedNumbers 
End With 

' add the new object to the collection 

Call mcolVariable. Add(udtVarFraction, Str(udtVar.Index)) 

'return the object created 
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Set AddFraction = udtVarFraction 
End Function 

Public Function AddString(ByVal strName As String, ByVal blnEnabled As Boolean, _ 
ByVal blnChecksum As Boolean, ByVal strDelimiter As String, _ 
ByVal blnlslndexed As Boolean, ByVal colString As Collection) As Variable 

'create a new object 

Dim udtVar As Variable 

Dim udtVarString As New VarString 

Set udtVar = udtVarString 

'set the properties passed into the method 
With udtVar 

.Typ = vtString 

.Name = strName 

.Enabled = blnEnabled 

.Index = NextID 

.Checksum = blnChecksum 
End With 

udtVarString.Delimiter = strDelimiter 
udtVarString.StringCoUection = colString 
udtVarString.IsIndexed = blnlslndexed 

' add the new object to the collection 

Call mcolVariable.Add(udtVarString, Str(udtVar index)) 

'return the object created 

Set AddString = udtVarString 

End Function 

Public Function AddUntyped(ByVal strName As String, ByVal blnEnabled As Boolean, 
ByVal blnChecksum As Boolean) 

'create a new object 

Dim udtVar As Variable 

Dim udtVarUntyped As New VarUntyped 

Set udtVar = udtVarUntyped 

'set the properties passed into the method 
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With udtVar 

.Typ = vtUntyped 

.Name = strName 

.Enabled = blnEnabled 

.Index = NextID 

.Checksum = blnChecksum 
End With 

' add the new object to the collection 

Call mcolVariable. Add(udtVarUntyped, Str(udtVar.Index)) 

'return the object created 

Set AddUntyped = udtVarUntyped 

End Function 

Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
'vntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolVariable.Remove vntlndexKey 

mblnlsDirty = True 

End Sub 



Public Property Get NewEnum() As lUnknown 
Attribute NewEnum. VB_UserMemId = -4 
Attribute NewEnum. VB_MemberFlags = '*40" 

'this property allows you to enumerate 
*this collection with the For... Each syntax 
Set NewEnum = mcol Variable. [_NewEnum] 

End Property 

Private Function NextlDQ As Long 

* creates a unique index to associate a variable and the variable listbox 
Static IngED As Long 



InglD = InglD + 1 
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NextID = InglD 



End Function 

* returns true if strName is already a variable name in the collection. If the 
' optional parameter is used, the function will not check that variable for a < 

Public Function UniqueName(ByVal strName As String, _ 
Optional ByVal bytSkipThisVar As Byte = 0, _ 
Optional ByVal udtSkipVar As Variable) As Boolean 

Dim udtVar As Variable 

UniqueName = True 

' Check for duplicate variable name 
For Each udtVar In mcolVariable 

If UCase(strName) = UCase(udtVar.Name) Then 
IfbytSkipThisVar= 1 Then 

If udtSkipVar.Index o udtVar.Index Then 
UniqueName = False 
Exit For 
End If 
Else 

UniqueName = False 
Exit For 
End If 
End If 

Next udtVar 

End Function 

' Check enabled variables in collection for duplicate names. 

Public Function DuplicateNamesQ As Boolean 

Dim udtVarl As Variable 
Dim udtVar2 As Variable 
Dim intll As Integer 
Dim intI2 As Integer 

DuplicateNames = False 
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For intll = 1 To mcolVariable.Count 
For intI2 = 1 To mcolVariable.Count 
If intll ointI2 Then 

Set udtVarl = mcolVariable.Item(intll) 
Set udtVar2 = mcolVariable.Item(intI2) 
If udtVarl. Enabled And udtVar2. Enabled Then 
If udtVarl.Name = udtVar2.Name Then 
DuplicateNarries = True 
Exit Function 
End If 
End If 
End If 
Next intI2 
Next intll 

End Function 

Public Sub ReadCollection(ByVal strFN As String, ByVal IngStartlndex As Long, 
ByVal IngEndlndex As Long) 

mudtFile.FileName = strFN 

Call mudtFile.ReadFile(Me, IngStartlndex, IngEndlndex) 
End Sub 

Public Sub ReadObjectsO 

Dim udtVar As Variable 
Dim udtType As VariableType 

On Error GoTo Beatit 

Do Until Err.Number o 0 

Set udtVar = New Variable 

udtType = udtVar.ReadType(mudtFile) 

Select Case udtType 
Case vtlnteger 

Set udtVar = New Varlnteger 

udtVar.Typ = vtlnteger 
Case vtReal 

Set udtVar = New VarReal 

udtVar.Typ = vtReal 
Case vtFraction 
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Set udtVar = New VarFraction 

udtVar.Typ = vtFraction 
Case vtString 

Set udtVar = New VarString 

udtVar.Typ = vtString 
Case vtUntyped 

Set udtVar = New VarUntyped 

udtVar.Typ = vtUntyped 
End Select 

Call udtVar.ReadObj ectData(mudtFile) 
udtVar index = NextID 

Call mcolVariable.Add(udtVar, Str(udtVar.Index)) 

Loop 

Beatit: 

Exit Sub 

End Sub 

Public Function WriteCollection(ByVal strFN As String, _ 
ByVal InglndexPos As Long, ByVal IngSeekPos) As Long 

mudtFile.FileName = strFN 

WriteCollection = niudtFile.WriteFile(Me, False, InglndexPos, IngSeekPos) 

mblnlsDirty = False 
End Function 
Public Sub WriteObjectsO 

Dim udtVar As Variable 

For Each udtVar In mcolVariable 

Call udtVar. WriteObjectData(mudtFile) 
Next udtVar 

End Sub 

Public Sub ClearO 

' empties the collection class 
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Set mcolVariable = Nothing 

Set mcolVariable = New Collection 



End Sub 

' returns a collection of variables sorted by length of variable 
* longest to shortest 

Public Function SortVarNamesByLengthQ As CVariables 

Dim udtVar As Variable 

Dim intLen As Integer 

Dim intLongest As Integer 

Dim udtCVar As New CVariables 

' Find longest variable name 
For Each udtVar In mcolVariable 
If udtVar.Enabled Then 
intLen = Len(udtVar.Name) 
If intLen > intLongest Then 

intLongest = intLen 
End If 
End If 
Next udtVar 

' Sort variables by length of name - longest first 
Do 

For Each udtVar In mcolVariable 
If udtVar.Enabled Then 
intLen = Len(udtVar.Name) 
If intLen = intLongest Then 
' Put this var in sorted collection 
udtCVar.AddObject udtVar 
End If 
End If 
Next udtVar 

intLongest = intLongest - 1 
Loop While intLongest > 0 

Set SortVarNamesByLength = udtCVar 

End Function 
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' CVariants.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
END 

Attribute VB_Name = "CVariants" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 



'to hold collection 

Private mcolVariants As Collection 

Private Sub Class_Initialize() 

'creates the collection when this class is created 
Set mcolVariant = New Collection 

End Sub 



Private Sub Class_Terminate() 

'destroys collection when this class is terminated 
Set mcolVariant = Nothing 

End Sub 

Public Property Get Item(vntIndexKey As Variant) As Variant 

'used when referencing an element in the collection 

'vntlndexKey contains either the Index or Key to the collection, 

'this is why it is declared as a Variant 

'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5) 

Set Item = mcolVariant(vntlndexKey) 

End Property 

Public Property Get CountQ As Long 
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'used when retrieving the number of elements in the 
'collection. Syntax: Debug.Print x. Count 
Count = mcolVariant. Count 

End Property 

Public Sub AddObject(udtVar As Variant) 
' adds variable objects directly to the collection 
udtVar.Index = NextID 

Call mcolVariant.Add(udtVar, Str(udtVar.Index)) 
End Sub 

Public Function Add(ByVal strName As String, _ 

ByVal strFrom As String, ByVal strTo As String, ByVal strBy As String) As Variant 

'create a nev^ object 

Dim udtVar As Variant 

Dim udtVarlnteger As New Varlnteger 

Set udtVar = udtVarlnteger 

'set the properties passed into the method 
With udtVar 

.Name = strName 

.Index = NextID 
End With 

With udtVarlnteger 

.From = StrFrom 

.Too = strTo 

.By = StrBy 
End With 

' add the new object to the collection 

Call mcolVariant.Add(udtVarInteger, Str(udtVar.Index)) 

'return the object created 

Set Addlnteger = udtVarlnteger 

End Function 
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Public Sub Remove(vntIndexKey As Variant) 

'used when removing an element from the collection 
'vntlndexKey contains either the Index or Key, which is why 
'it is declared as a Variant 
'Syntax: x.Remove(xyz) 
mcolVariant.Remove vntlndexKey 

End Sub 



Public Property Get NewEnumQ As lUnknown 

'this property allows you to enumerate 
'this collection with the For... Each syntax 
Set NewEnum = mcol Variant. [_NewEnum] 

End Property 

Private Function NextlDQ As Long 

' creates a unique index to associate a variable and the variable listbox 
Static InglD As Long 

InglD = InglD + 1 
NextID = InglD 

End Function 

Public Sub ClearO 

' empties the collection class 

Set mcolVariant = Nothing 
Set mcolVariant = New Collection 

End Sub 

\ 
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* DifficultyEstimate.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
END 

Attribute VB_Name = "DifficultyEstimate" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mblnlsDirty As Boolean 
Private Sub Class_Initialize() 

mblnlsDirty = False 
End Sub 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean ^ 

IsDirty = mblnlsDirty 
End Property 

' implemented in the subclasses of DifficultyEstimate 
Public Function ComputeDifficultyQ As Double 

End Function 

' implemented in the subclasses of DifficultyEstimate 
Public Function Copy() As DifficultyEstimate 

End Function 

' implemented in the subclasses of DifficultyEstimate 
Public Sub ReadObjectData(udtFile As File) 
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End Sub 

' implemented in the subclasses of DifficultyEstimate 
Public Sub WriteObjectData(udtFile As File) 

End Sub 
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' DocStatus.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
5 END 

Attribute VB_Name = "DocStatus" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

* returns true if this document strFN is open 

Public Function IsOpen(ByVal strFN As String) As Boolean 



15 



Dim docD As Document 



For Each docD In Documents 

5 If InStr( 1 , StrFN, docD.Name) Then 

gi IsOpen = True 

yl Exit Function 

2m End If 

ffl Next docD 

'^^ IsOpen = False 

hi End Function 
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' DSMODEL.CLS 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 

Persistable = 0 *NotPersistable 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior =0 VbNone 

MTSTransactionMode = 0 'Not AnMTS Object 
END 

Attribute VB_Name = "DSModel" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable - False 
Attribute VBPredeclaredld = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Model 

Dim mudtModel As Model 

Private Sub Class_Initialize() 

Set mudtModel = New Model 

End Sub 

' Delegated to Class Model 

Public Property Get Model_FileName() As String 

Model_FileName = mudtModel.FileName 

End Property 

' Delegated to Class Model 

Public Property Let Model_FileName(ByVal strNewValue As String) 

mudtModel.FileName = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsFrozen() As Boolean 
Model IsFrozen = mudtModel.IsFrozen 
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End Property 

* Delegated to Class Model 

Public Property Let Model_IsFrozen(ByVal blnNewValue As Boolean) 

mudtModel.IsFrozen = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Comments() As String 

Model_Comments = mudtModel. Comments 
End Property 

' Delegated to Class Model 

Public Property Let Model_Comments(ByVal strNewValue As String) 

mudtModelComments = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Clones() As CClones 

Set Model_Clones = mudtModel. Clones 

End Property 

' Delegated to Class Model 

Public Property Get Model_Variables() As CVariables 

Set Model_Variables = mudtModel. Variables 
End Property 

' Delegated to Class Model 

Public Property Get Model_Constraints() As CConstraints 

Set Model_Constraints = mudtModel.Constraints 
End Property 
^Delegated to Class Model 
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Public Sub Model_AddChecksum(ByVal dblChecksum As Double) 

Call mudtModel.AddChecksum(dblChecksum) 
End Sub 

' Delegated to Class Model 

Public Sub Model_InitChecksums() 

mudtModel.InitChecksums 

End Sub 

' Delegated to Class Model 

Public Sub Model_InitTempChecksums() 

mudtModel . InitTemp Checksums 

End Sub 

'Delegated to Class Model 

Public Function Model_ChecksumExists(ByVal dblChecksum As Double) As Boolean 

Model_ChecksumExists = mudtModel. ChecksumExists(dblChecksum) 
End Function 

' Delegated to Class Model 

Public Property Let Model_IsDirty(ByVal blnNewValue As Boolean) 

mudtModel.IsDirty = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsDirty() As Boolean 

ModellsDirty = mudtModel.IsDirty 

End Property 

' Delegated to Class Model 

Public Property Let Model_LastClone(ByVal intNewValue As Integer) 
mudtModel.LastClone = intNewValue 
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End Property 

' Delegated to Class Model 

Public Property Get Model_LastClone() As Integer 

Model_LastClone = mudtModel.LastClone 

5 End Property 

' Delegated to Class Model 
Public Sub Model_FreezeModel() 

Call mudtModel.FreezeModel 

End Sub 

1 0 ' Delegated to Class Model 

Public Sub Model_OpenDoc(ByVal udtWord As MSWord) 

^ Call mudtModel.OpenDoc(udtWord) 

Ul End Sub 

i|3 ' Delegated to Class Model 

1 |i Public Sub Model_CloseDoc() 



« Call mudtModel.CloseDoc 

^ End Sub 

' Delegated to Class Model 

Public Sub Model_CloseAllCloneDocs() 

20 Call mudtModel.CloseAllCloneDocs 

End Sub 

' Delegated to Class Model 
Public Sub Model_ReadModel() 

mudtModel.ReadModel 

25 End Sub 

' Delegated to Class Model 
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Public Sub Model_ReadObjects() 

mudtModel.ReadObj ects 
End Sub 

' Delegated to Class Model 
Public Sub Model_WriteModel() 

mudtModel.WriteModel 

End Sub 

' Delegated to Class Model 
Public Sub Model_WriteObjects() 

mudtMo del . Wri t eObj ects 

End Sub 

' Delegated to Class Model 

Public Function Model_ConstraintsOK(ByVal udtTestType As TestType, _ 
ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 
blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

Model_ConstraintsOK = mudtModel.ConstraintsOK(udtTestType, udtProlog, _ 
blnUnderconstrained, blnTestAborted, strUnderconstrainedVN) 

End Function 

' implemented here 

Public Sub Model_GenerateClones(By Val udtWord As MSWord, ByVal udtProlog As Prolog, 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

Call mudtModel.SubstituteValues(Me, udtWord, udtProlog, intNumClones, _ 
bytDifference, 285) 

End Sub 

' Delegated to Class Model 

Public Sub Model_SubstituteValues(ByVal objO As Object, _ 
ByVal udtWord As MSWord, ByVal udtProlog As Prolog, _ 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, _ 
ByVal intStartPos As Integer) 
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End Sub 

Public Sub CreateVariant(ByVal udtClone As Clone) 

Dim mumber As Integer 
Dim statementRange As Range 
Dim firstNSE As String 
Dim secondNSE As String 

With udtClone.CloneDoc 

mumber = .Tables(l).Rows.Count * Rnd + 0.5 
.Tables(l).Cell(Row:=mumber, Column:=l).Range.Copy 
firstNSE = .Tables(l).Cell(Row:=mumber, Column:=2).Range.Text 
firstNSE = left(firstNSE, 1) 

Set StatementRange = .Bookmarks("tca_fStatement").Range 

statementRange.Paste 

.Tables(l).ConvertToText 

.Bookmarks.Add name:="tca_fStatement", Range :=statementRange 
statementRange.Borders.OutsideLineStyle = wdLineStyleSingle 

' trim hard returns at end of statement 
Dim i, n As Integer 
Dim retchr As String 
retchr = Chr$(13) 

With statementRange 
n = 0 

i - .Words. Count 

While .Words(i).Text = retchr And i > 1 
i = i- 1 

If . Words(i).Text = retchr Then 

n = n+ 1 
End If 
Wend 

Ifn>OThen 

.Words(.Words.Count - n + l).Delete Count:=n 
End If 
End With 

mumber = .Tables(2).Rows.Count * Rnd + 0.5 
.Tables(2).Cell(Row:=mumber, Column:=l), Range. Copy 
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secondNSE .Tables(2).Cell(Row:=mumber, Column:=2).Range.Text 
secondNSE = left(secondNSE, 1) 

Set statementRange = .Bookmarks("tca_sStatement").Range 
statementRange .Paste 
.Tables( 1 ) . ConvertToText 

.Bookmarks.Add name:="tca_sStatement", Range :=statementRange 
statementRange.Borders.OutsideLineStyle = wdLineStyleSingle 

' trim hard returns at end of statement 
With StatementRange 
n = 0 

i = .Words.Count 

While .Words(i).Text = retchr And i > 1 
i = i- 1 

If .Words(i).Text = retchr Then 

n = n+ 1 
End If 
Wend 

Ifn>OThen 

.Words(. Words.Count - n + l).Delete Count:=n 
End If 
End With 

Dim key As String 
Dim keyChr As String 

If firstNSE = "N" And secondNSE = "N" Then 
key = "E" 

Elself firstNSE = "S" And secondNSE = "S" Then 

key = "C or E" 
Elself firstNSE = "E" And secondNSE = "E" Then 

key = "D" 

Elself firstNSE = "N" And secondNSE = "S" Then 
key = "E" 

Elself firstNSE = "E" And secondNSE = "S" Then 
key = "A" 

Elself firstNSE = "S" And secondNSE = "E" Then 
key = "B" 

Elself firstNSE = "N" And secondNSE = "E" Then 
key = "B" 

Elself firstNSE = "E" And secondNSE = "N" Then 
key = "A" 
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End If 

keyChr = left(.Bookmarks("key").Range.Text, 1) 

If keyChr = "A" Or keyChr = "1" Then 
key = "A" 

5 Elself keyChr - "B" Or keyChr = "2" Then 

key = "B" 

Elself keyChr = "C" Or keyChr = "3" Then 
key = "C" 

Elself keyChr = "D" Or keyChr = "4" Then 
10 key = "D" 

Elself keyChr = "E" Or keyChr = "5" Then 

key = "E" 
End If 

Dim keyRange As Range 
15 Set keyRange = .Bookmarks("tca_Key").Range 

JJ Ifkey = ""Then 

01 keyRange.InsertBefore Text:="TCA cannot determine the key" 

U1 Else 

4= keyRange.InsertBefore Text:="Key is " & key 

2^3 End If 

udtClone.key = key 

s 

y End With 
K End Sub 
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* Family.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l 'True 
END 

Attribute VB_Name = "Family" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

' enable i/o 

Private mudtFile As File 

' the .mdf file name of this family 
Private mstrFamilyFN As String 

' the program that ov^ns this family 
Private mudtProgram As Program 

' the item type 

Private mudtltemType As ItemType 

' close/medium far classification 
Private mudtProximity As Proximity 

' generic/non-generic classification 
Private mblnGeneric As Boolean 

' accession number, if this family is based on a locked item 
Private mstrAccNum As String 

' the active model 

Private mudtActiveModel As Model 

' collection of Models 

Private mudtCModels As CModels 

' the collection of accepted clones 
Private mudtCClones As CClones 
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' is dirty? 

Private mblnlsDirty As Boolean 

Public Enum Program 

prGRE = 0 
5 prGMAT = 1 

prSAT = 2 

prMR = 3 
End Enum 

Public Enum ItemType 
10 ptStandardMC = 0 

ptQuantComp = 1 

ptDataSuff=2 
End Enum 

Public Enum Proximity 
1 5 prNear = 0 

prMedium = 1 
prFar = 2 
yi End Enum 
U1 ■ 

4^ Private Enum FamilyRecordLayout 
20 frLocalDatalndex = 1 ' long (takes 4 bytes) 
4^ frClonelndex = 5 ' long 
^ frLocalData = 51 
1^ frClones = 201 ' variable length 
^ End Enum 

2E Private Sub Class_Initialize() 

n Set mudtCModels = New CModels 
Set mudtCClones = New CClones 
mblnlsDirty = False 

End Sub 

30 Public Property Get FileNameQ As String 
FileName = mstrFamilyFN 
End Property 

Public Property Let FileName(ByVal strNewValue As String) 
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mstrFamilyFN = left(strNew Value, Len(strNewValue) - 4) & ".mdf ' 
End Property 

Public Property Get ProgramQ As Program 

Program = mudtProgram 
End Property 

Public Property Let Program(By Val udtNewValue As Program) 

mudtProgram = udtNewValue 
End Property 

Public Property Get ItemTypeQ As ItemType 

ItemType = mudtltemType 
End Property 

Public Property Let ItemType(By Val udtNewValue As ItemType) 

mudtltemType - udtNewValue 
End Property 

Public Property Get ProximityQ As Proximity 

Proximity = mudtProximity 
End Property 

Public Property Let Proximity(ByVal udtNewValue As Proximity) 

mudtProximity = udtNewValue 
End Property 

Public Property Get GenericQ As Boolean 

Generic = mblnGeneric 
End Property 

VBSCA -324- 



Public Property Let Generic(ByVal blnNewValue As Boolean) 

mblnGeneric = blnNewValue 
End Property 

Public Property Get AccNumQ As String 

5 

AccNum = mstrAccNum 
End Property 

Public Property Let AccNum(ByVal strNewValue As String) 
mstrAccNum = strNewValue 
10 End Property 

Public Property Get ActiveModelQ As Model 

Set ActiveModel = mudtActiveModel 
End Property 

1 ^ Public Property Let ActiveModel(By Val udtModel As Model) 
L. Set mudtActiveModel = udtModel 

L.J 

■'^l End Property 

Q Public Property Get ModelsQ As CModels 
20 Set Models = mudtCModels 

End Property 

Public Property Get ClonesQ As CClones 

Set Clones = mudtCClones 
End Property 

25 Public Property Let IsDirty(ByVal blnNewValue As Boolean) 
mblnlsDirty = blnNewValue 
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End Property 

Private Property Get IsDirtyQ As Boolean 

If mudtCClones.IsDirty Or mblnlsDirty Then 
5 IsDirty = True 

Else 

IsDirty = False 
End If 

1 0 End Property 

Public Sub CloseAllCloneDocsQ 

Dim udtClone As Clone 

For Each udtClone In mudtCClones 
1 f 1 udtClone.CloseDoc 
m Next udtClone 
w i 

Ul End Sub 

Public Sub ReadFamilyO 

2^=^ Dim udtWAPI As New Win32API 

% If udtWAPI.FileExists(mstrFamilyFN) Then 
0 Set mudtFile = New File 

Lfe mudtFile.FileName = mstrFamilyFN 

2g3 Call mudtFile.ReadFile(Me, frLocalDatalndex, frClonelndex) 

D Set mudtFile = Nothing 

Call mudtCClones.ReadCollection(mstrFamilyFN, frClonelndex, READ_UNTIL_EOF) 
End If 

30 End Sub 

Public Sub ReadObjectsO 

Dim vField As Variant 

Call mudtFile.ReadField(vField) ' returns the version stamp 
35 Call mudtFile.ReadField(vField) 

Program = vField 
Call mudtFile.ReadField(vField) 
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ItemType = vField 

Call mudtFile.ReadField(vField) 

Generic = vField 

Call mudtFile.ReadField(vField) 

Proximity = vField 

Call mudtFile.ReadField(vField) 

AccNum = vField 

End Sub 

Public Sub WriteFamilyQ 

Dim udtPB As New Progress 

IflsDirty Then 

Set mudtFile = New File 
mudtFile.FileName = mstrFamilyFN 
Call udtPB.Init(2, "Saving family..,") 

Call mudtFile. WriteFile(Me, True, frLocalDatalndex, frLocalData) 

udtPB. Advance 

Set mudtFile = Nothing 

Call mudtCClones.WriteCollection(mstrFamilyFN, frClonelndex, frClones) 
udtPB. Advance 
End If 

IsDirty = False 
End Sub 

Public Sub WriteObjectsO 

Call mudtFile. WriteField(mintVERSIONSTAMP) 

Call mudtFile.WriteField(Program) 

Call mudtFile. WriteField(ItemType) 

Call mudtFile. WriteField(Generic) 

Call mudtFile. WriteField(Proximity) 

Call mudtFile. WriteField(AccNum) 

End Sub 
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' File.cls 

VERSION 1.0 CLASS 
BEGIN 

MultiUse = 0 'False 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior =0 VbNone 

MTSTransactionMode = 0 'Not AnMTS Object 
END 

Attribute VB_Name = "File" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VBExposed = False 
Option Explicit 

' Path and name of the file to open 
Private m_sFileName As String 

' File number opened 

Private m_iFileNumber As Integer 

' passed in by ReadFile 
Private mlngEndPos As Long 

' Error constants 
Enum FileError 

fileOpenError = vbObjectError + 512 + 2 

fileEOFError = vbObjectError + 512 + 3 

fileReadError = vbObjectError + 512 + 4 

fileWriteError = vbObjectError +512 + 5 

fileStopReadingError = vbObjectError +512 + 6 
End Enum 

Property Get FileNameQ As String 

Attribute FileName.VB_Description = "Name of the file to contain the task information." 

FileName = m_sFileName 
End Property 

Property Let FileName(ByVal sFileName As String) 
' Should validate valid path here 
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m_sFileName = sFileName 
End Property 

* Reads all objects from a file into the defined object 
' Parameters: 

Public Sub ReadFile(obj As Object, Optional ByVal IngStartlndex As Long = 0, 
Optional ByVal IngEndlndex As Long = 0) 

Dim IngStartPos As Long 

1 0 ' Enable error handling 

On Error Resume Next 

' Get the file number 
miFileNumber = FreeFile 

15 

' Open the file and trap any errors 
£1 Open m_sFileName For Binary Access Read As #m_iFileNumber 



2©1 



Select Case err.Number 



4^^ Case 0 ' No error 

-4f If IngEndlndex > 0 Then 

^ Seek m_iFileNumber, IngEndlndex 

'^"^ Get #m_iFileNumber, , mlngEndPos 

2%^ Else 

% mlngEndPos = 0 

p{ End If 

U If IngStartlndex >0 Then 

Q Seek m iFileNumber, IngStartlndex 

391 Get #mJFileNumber, , IngStartPos 

Seek m_iFileNumber, IngStartPos 
End If 

obj.ReadObjects ' Get the data 

35 Case 53 ' File not found 

' Do nothing 

Case Else 
' Turn off error handling here 
40 On Error GoTo 0 

' Pass the error out 

err.Raise fileOpenError, "CFile::ReadFile", "Error opening file." 
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End Select 
' Close the file 
Close #m_iFileNumber 
End Sub 

' Reads a field from the file 
' Parameters: 

* vField field read from the file 

Public Sub ReadField(vField As Variant) 
' Set the error handler 
On Error GoTo ERR_HANDLER 

Get #m_iFileNumber, , vField 

If EOF(m_iFileNumber) Then 

* Reached end of file 

err.Raise fileEOFError 
End If 

If mlngEndPos > 0 Then 

If mlngEndPos < Seek(m_iFileNumber) Then 
err.Raise fileStopReadingError 

End If 
End If 

Exit Sub 

ERR_HANDLER: 
' Pass the error out 
Select Case err.Number 

Case fileEOFError 

Call err.Raise(err.Number, "File::ReadField", "EOF") 
Case fileStopReadingError 

Call err.Raise(err.Number, "File::ReadField'\ "Stop!") 
Case Else 

Call err.Raise(fileReadError, "File::ReadField", err.Descript 
End Select 
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End Sub 

' Writes all objects to the file. 

' Parameters: 

' obj Object 
5 Public Function WriteFile(obj As Object, _ 

Optional By Val blnKillOldFile As Boolean = False, _ 
Optional ByVal InglndexPos As Long = 0, _ 
Optional By Val IngSeekPos As Long = 1) As Long 

' Enable error handling 
1 0 On Error Resume Next 

If blnKillOldFile Then ' assume new file, otherwise append 
Kill m_sFileName * Kill the existing file 
err.Clear 

End If 

1 S^: ' Get the file number 



25: 



m iFileNumber = FreeFile 



Ul * Open the file and trap any errors 

4^ Open m_sFileName For Binary As #m_iFileNumber 

' write the starting file position, if InglndexPos > 0 
If InglndexPos > 0 Then 

Seek m_iFileNumber, InglndexPos 
Put #m_iFileNumber, , IngSeekPos 
End If 



' seek to starting position 

Seek m_iFileNumber, IngSeekPos 



Select Case err.Number 
30 CaseO 'No error 

' Write the data 
obj.WriteObjects 

Case Else 

' Turn off error handling here 
35 On Error GoToO 



* Pass the error out 

err.Raise fileOpenError, "CFile::WriteFile", _ 
"Error opening file: " & err.Description 
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End Select 



* return current position 
WriteFile = Seek(m_iFileNumber) 

' Close the file 

Close #m_iFileNumber 

End Function 

' Write a field to the file 
' Parameters: 

' vField field to write to the file 

Public Sub WriteField(ByVal vField As Variant) 

* Set the error handler 

On Error GoTo ERR_HANDLER 

Put #m_iFileNumber, , vField 

Exit Sub 

ERR_HANDLER: 

err.Raise fileWriteError, "CFile::WriteField", _ 
"Write Error: " & err.Descpription 
End Sub 
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' FileFind.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l 'True 
END 

Attribute VB_Name = "FileFind" 
Attribute VBGlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VBPredeclaredld = False 
Attribute VB_Exposed = False 
Option Explicit 

' used for finding files that fit a mask 



Private Type FILETIME 

dwLowDateTime As Long 

dwHighDateTime As Long 
End Type 

Private Const MAX_PATH = 260 

Private Type WIN32_FIND_DATA 

dwFileAttributes As Long 

flCreationTime As FILETIME 

fILastAccessTime As FILETIME 

ftLastWriteTime As FILETIME 

nFileSizeHigh As Long 

nFileSizeLow As Long 

dwReservedO As Long 

dwReservedl As Long 

cFileName As String * MAX_PATH 

c Alternate As String * 14 
End Type 

Private Const INVALID_HANDLE_VALUE = -1 

Private Declare Function FindFirstFile Lib "kemel32" Alias "FindFirstFileA" _ 
(ByVal IpFileName As String, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindNextFile Lib "kemel32" Alias "FindNextFileA" _ 
(ByVal hFileName As Long, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindClose Lib "kemel32" (ByVal hFindFile As Long) As Long 
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Private Declare Function GetCurrentDirectory Lib "kemel32" _ 
Alias "GetCurrentDirectoryA" (ByVai nBufferLength As Long, _ 
ByVal IpBuffer As String) As Long 

' returns true if strFN exists 

Public Function Exists(ByVal strFN) As Boolean 

Dim IngHandle As Long 

Dim w32FindData As WIN32_FIND_DATA 

IngHandle = FindFirstFile(strFN, w32FindData) 

If IngHandle = INVALID_HANDLE_VALUE Then 

Exists = False 
Else 

Exists = True 

Call FindClose(lngHandle) 
End If 

End Function 

' returns a collection of file names that satisfy strMask. The path seems to 
' disappear fi-om the returned file names. 

Public Function FindAll(ByVal strMask As String) As Collection 

Dim IngHandle As Long 
Dim IngRet As Long 

Dim w32FindData As WIN32_FIND_DATA 

Dim StrFN As String 

Dim varl As Variant 

Dim colFNs As New Collection 

IngHandle = FindFirstFile(strMask, w32FindData) 

If IngHandle = INVALID_HANDLE_VALUE Then 

Exit Function 
End If 

Do 

varl = InStr(l, w32FindData.cFileName, Chr(O)) ' trim off the nulls 
StrFN = left(w32FindData.cFileName, varl - 1) 
Call colFNs. Add(strFN) ' add to the collection 

Loop Until FindNextFile(lngHandle, w32FindData) = 0 
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Set FindAll = colFNs 
End Function 

' returns the current directory 

Public Function CurrentDirectoryQ As String 

Dim strBuf As String 
Dim IngRet As Long 
Dim varl As Variant 

StrBuf =Space(300) 

IngRet = GetCurrentDirectory(300, strBuf) 
varl = InStr(l, strBuf, Chr(O)) ' trim off the nulls 
CurrentDirectory = left(strBuf, varl - 1) 

End Function 
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• GMATDifficultyEstimate.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 
5 END 

Attribute VB_Name = "GMATDifficultyEstimate" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Implements DifficultyEstimate 

15. Private mudtDE As DifficultyEstimate 

' these go into the GMAT model 

Private mudtDomain As Domain 
J:; Private mstrKey As String 
i,f ] Private mudtNature As Nature 

Private mudtltemType As ItemType 
^3 Private mintTDDiffEst As Integer 

Cf Private Sub Class_InitiaUze() 

'r"^ Set mudtDE = New DifficultyEstimate 

End Sub 

Private Sub Class_Terminate() 

Set mudtDE = Nothing . 
End Sub 

Public Property Get DifficultyEstimate_IsDirty() As Boolean 
30 DifficultyEstimateJsDirty = mudtDE.IsDirty 

End Property 
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Public Property Let DifficultyEstimate_IsDirty(ByVal blnNewValue As Boolean) 

mudtDE.IsDirty = blnNewValue 
End Property 

Public Property Let Domain(ByVal udtNewValue As Domain) 

mudtDomain = udtNewValue 
End Property 

Public Property Let Nature(ByVal udtNewValue As Nature) 

mudtNature = udtNewValue 
End Property 

Public Property Let Key(ByVal strNewValue As String) 

mstrKey = strNewValue 
End Property 

Public Property Let ItemType(ByVal udtNewValue As ItemType) 

mudtltemType - udtNewValue 
End Property 

Public Property Let TDDiffEst(ByVal intNewValue As Integer) 

mintTDDifffist = intNewValue 
End Property 

Public Function DifficultyEstimate_ComputeDifficulty() As Double 

Dim dblDiff As Double 

dblDiff-. 2.3289902 

' add coeff for domain 
If mudtDomain = doAlgebra Then 
dblDiff = dblDiff + 0.2341578 
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Elself mudtDomain = doGeometry Then 

dblDiff = dblDiff + 0.3749013 
End If 

' add coeff for real 

If mudtNature = naReal Then 

dblDiff = dblDiff + 0.3285613 
End If 

' add coeff for td difficulty estimate 

dblDiff = dblDiff + ((6 - mintTDDifffist) * 0.7024191) 

' add coeff for key 

If mudtltemType = ptDataSuff Then 

If mstrKey = "A" Or mstrKey = "B" Then 
dblDiff = dblDiff + 0.7334054 

End If 
End If 

DifficultyEstimate_ComputeDifficulty = dblDiff 
End Function 

' returns a copy of this object 

Public Function DifficultyEstimate_Copy() As DifficultyEstimate 
Dim udtGmatDE As New GMATDifficultyEstimate 
Set DifficultyEstimate_Copy = udtGmatDE 

End Function 

Public Sub DifficultyEstimate_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' reads the version stamp 
End Sub 

Public Sub DifficultyEstimate_WriteObjectData(udtFile As File) 
Call udtFile.WriteField(mintVERSIONSTAMP) 
mudtDE.IsDirty = False 
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End Sub 



01 
Ul 
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' GREDifficultyEstimate.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
END 

Attribute VB_Name = "GREDifficultyEstimate" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable - True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer - 1 

Implements DifficultyEstimate 

Private mudtDE As DifficultyEstimate 

' these go into the GRE model 

Private mudtDomain As Domain 

Private mudtComputation As GREComputation 

Private mudtCognition As GRECognition 

Private mudtConcept As GREConcept 

Private mstrKey As String 

Private mudtNature As Nature 

Private mudtltemType As ItemType 

Pubhc Enum GREComputation 

grintegers = 0 

grDecimalsFractions = 1 

grRadicals = 2 

grNone = 3 
End Enum 

Public Enum GRECognition 

grProcedural = 0 

grConceptual = 1 

grHigherOrderThinking = 2 
End Enum 

Public Enum GREConcept 
grProbability = 0 
grPercentofPercent = 1 



grPercentChange = 2 
grLinearlnequality = 3 
grNoneOfThese = 4 
End Enum 

Private Sub Class_Initialize() 

Set mudtDE = New DifficultyEstiinate 
End Sub 

Private Sub Class_Terminate() 

Set mudtDE = Nothing 
End Sub 

Public Property Get DifficultyEstimate_IsDirty() As Boolean 

DifficultyEstimate_IsDirty = mudtDE.IsDirty 
End Property 

Public Property Let DifficultyEstimate_IsDirty(ByVal blnNew Value As Boolean) 

mudtDE.IsDirty = blnNewValue 
End Property 

Public Property Let Domain(ByVal udtNewValue As Domain) 

mudtDomain = udtNewValue 
End Property 

Public Property Get ComputationQ As GREComputation 

Computation = mudtComputation 
End Property 

Public Property Let Computation(By Val udtNewValue As GREComputation) 

If mudtComputation o udtNewValue Then 
mudtComputation = udtNewValue 
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mudtDE.IsDirty = True 
End If 

End Property 

Public Property Get CognitionQ As GRECognition 

Cognition = mudtCognition 
End Property 

Public Property Let Cognition(By Val udtNewValue As GRECognition) 

If mudtCognition <> udtNewValue Then 

mudtCognition = udtNewValue 

mudtDE.IsDirty = True 
End If 

End Property 

Public Property Get ConceptQ As GREConcept 

Concept = mudtConcept 
End Property 

Public Property Let Concept(ByVal udtNewValue As GREConcept) 

If mudtConcept o udtNewValue Then 

mudtConcept = udtNewValue 

mudtDE.IsDirty = True 
End If 

End Property 

Public Property Get NatureQ As Nature 

Nature = mudtNature 
End Property 

Public Property Let Nature(ByVal udtNewValue As Nature) 
mudtNature = udtNewValue 
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End Property 

Public Property Get Key() As String 

Key = mstrKey 
End Property 

Public Property Let Key(ByVal strNewValue As String) 

If mstrKey <> strNewValue Then 

mstrKey = strNewValue 

mudtDE.IsDirty = True 
End If 

End Property 

Public Property Get ItemType() As ItemType 

ItemType = mudtltemType 
End Property 

Public Property Let ItemType(ByVal udtNewValue As ItemType) 

mudtltemType = udtNewValue 
End Property 

Public Function DifficultyEstimate_ComputeDifficulty() As Double 

Dim dblDiff As Double 

dblDiff- 0.3296816 

' add coeff for domain 

If mudtDomain = doAlgebra Then 

dblDiff = dblDiff -f 0.2464302 
Elself mudtDomain = doDataAnalysis Then 

dblDiff = dblDiff - 0,3944198 
End If 

' add coeff for computation 
If mudtComputation = grintegers Then 
dblDiff = dblDiff - 0.8563799 
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Elself mudtComputation = grDecimalsFractions Then 

dblDiff =dblDiff- 0.5181709 
End -If 

' add coeff for cognition 
If mudtCognition = grProcedural Then 
dblDiff = dblDiff - 0.6621277 

If mudtNature = naReal Then * add coeff for procedural and real 

dblDiff- dblDiff - 0.8781659 
End If 

Elself mudtCognition = grHigherOrderThinking Then 

dblDiff = dblDiff + 0.7253093 
End If 

* add coeff for concept 
Select Case mudtConcept 
Case grLinearlnequality 

dblDiff = dblDiff - 0.5881492 
Case grNoneOfThese 

* do nothing 
Case Else 

dblDiff = dblDiff + 0.5835095 
End Select 

' add coeff for key 

If mudtltemType = ptQuantComp Then 

If mstrKey = "A" Or mstrKey = "B" Or mstrKey = "C" Then 
dblDiff = dblDiff - 0.531099 

End If 
End If 

DifficultyEstimate_ComputeDifficulty = dblDiff 
End Function 

' returns a copy of this object 

Public Function DifficultyEstimate_Copy() As DifficultyEstimate 

Dim udtGreDE As New GREDifficultyEstimate 

udtGreDE.Computation = Computation 
udtGreDE.Cognition = Cognition 
udtGreDE.Concept = Concept 

Set DifficultyEstimate_Copy = udtGreDE 
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End Function 

Public Sub DifficultyEstimate_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' reads the version stamp 

Call udtFile.ReadField(vField) 
Computation = vField 

Call udtFile.ReadField(vField) 
Cognition = vField 

Call udtFile.ReadField(vField) 
Concept - vField 

End Sub 

Public Sub DifficultyEstimate_WriteObjectData(udtFile As File) 

CalludtFile.WriteField(mintVERSIONSTAMP) 
Call udtFile . WriteField(Computation) 
Call udtFile.WriteField(Cognition) 
Call udtFile.WriteField(Concept) 

mudtDE.IsDirty = False 

End Sub 



' IniFile.cls 

VERSION 1.0 CLASS 
BEGIN 

MultiUse = -1 'True 
END 

Attribute VB_Name = "IniFile" 
Attribute VBGlobalNameSpace = False 
Attribute VBCreatable = True 
Attribute VBPredeclaredId = False 
Attribute VBExposed = False 

' this class handles all ini file reads and writes via kemel32 
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Option Explicit 

' the following declares are needed to get and put to .ini files 

Private Declare Function GetPrivateProfileSection Lib "kemel32" Alias _ 

"GetPrivateProfileSectionA" (ByVal IpAppName As String, _ 

ByVal IpRetumedString As String, ByVal nSize As Long, _ 

ByVal IpFileName As String) As Long 

Private Declare Function GetPrivateProfileString Lib "kemel32" Alias _ 
"GetPrivateProfileStringA" (ByVal IpApplicationName As String, _ 
ByVal IpKeyName As Any, ByVal IpDefault As String, _ 
ByVal IpRetumedString As String, ByVal nSize As Long, _ 
ByVal IpFileName As String) As Long 

Private Declare Function WritePrivateProfileSection Lib "kemel32" Alias _ 
"WritePrivateProfileSectionA" (ByVal IpAppName As String, _ 
ByVal IpString As String, ByVal IpFileName As String) As Long 

Private Declare Function WritePrivateProfileString Lib "kemel32" Alias _ 
"WritePrivateProfileStringA" (ByVal IpApplicationName As String, _ 
ByVal IpKeyName As Any, ByVal IpString As Any, ByVal IpFileName As String) 
As Long 

' contains file name of ini 
Private mstrFN As String 

* holds collection of keys created by Get ProfileSection method 
Private mcolKeys As Collection 

' holds collection of values created by Get ProfileSection method 
Private mcolValues As Collection 

Private Sub Class_Initialize() 

Set mcolKeys = New Collection 
Set mcolValues = New Collection 

End Sub 

' sets the ini path + file name 

Public Property Let FN(ByVal strFN As String) 

mstrFN = strFN 

End Property 
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' returns the ini path + file name 
Public Property Get FN() As String 

FN = mstrFN 

5 End Property 

'gets all of the keys and values in a section 

Public Sub GetProfileSection(ByVal strSectionName As String) 

Dim strRet As String 
strRet = Space(5000) 

10 If GetPrivateProfileSection(strSectionName, strRet, 5000, mstrFN) - 0 Then 

Call MsgBox("Ini file call unsuccessful", vbExclamation, "Error") 
End If 

Dim IngStart As Long 
1^^ Dim IngEnd As Long 
.J3 Dim strl As String 
y'i Dim str2 As String 

yi Dim varT As Variant 

4= Dim strT As String 

2% ' parse the key and variable names out of strRet, add to the collections 

^ For IngStart = 1 To Len(strRet) 

I, strl = Mid(strRet, IngStart, 1) 

y If strl oChr(O) Then 

pl; For IngEnd = IngStart + 1 To Len(strRet) 

2j: str2 =Mid(strRet, IngEnd, 1) 

Select Case str2 
m Case "=" 

StrT = Mid(strRet, IngStart, IngEnd - IngStart) 
Call mcolKeys.Add(strT) 
30 Exit For 

Case Chr(0) 

StrT = Mid(strRet, IngStart, IngEnd - IngStart) 
Call mcolValues.Add(strT) 
Exit For 

35 End Select 

Next IngEnd 
IngStart = IngEnd 
End If 
Next IngStart 

40 
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End Sub 



' called after LoadProfileSection. 

' sets strKey and strValue to the the KeyValue pairs if one exists 
' at this index. 

' returns TRUE if the index exists, FALSE if it doesn't. 

Public Function GetKeyValuePair(strKey As String, strValue As String, _ 
ByVal intlndex As Integer) As Boolean 

If intlndex <= mcolKeys.Count Then 

StrKey = mcolKeys Jtem(intlndex) 

StrValue = mcol Values. Item(intlndex) 

GetKeyValuePair = True 
Else 

StrKey - 

StrValue = 

GetKeyValuePair = False 
End If 

End Function 

' init before loading key/value pairs 
Public Function InitializeKey ValuePairsQ 

Set mcolKeys = Nothing 
Set mcolValues = Nothing 
Set mcolKeys = New Collection 
Set mcolValues = New Collection 

End Function 

Public Sub SetKeyValuePair(ByVal strKey As String, ByVal strValue As String) 

Call mcolKeys.Add(strKey) 
Call mcolValues. Add(strValue) 

End Sub 

Public Sub WriteProfileSection(ByVal strSectionName As String) 

Dim strSection As String 
Dim varKey As Variant 
Dim varValue As Variant 
Dim inti As Integer 
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For Each varKey In mcolKeys 
inti = inti + 1 

varValue = mcolValues.Item(intl) 

strSection = strSection & varKey & & varValue & Chr(O) 
Next varKey 

If WritePrivateProfileSection(strSectionName, strSection, mstrFN) = 0 Then 
Call MsgBox("Ini file write section call unsuccessful", _ 
vbExclamation, "Error") 

End If 

End Sub 

' returns the number of keys currently in the key/value collections 
Public Property Get NuniKeys() As Integer 

NumKeys = mcolKeys.Count 

End Property 

'gets a value 

Public Function GetProfileString(ByVal strSectionName As String, _ 
ByVal strKeyName As String) As String 

Dim strRet As String 
strRet = Space(5000) 

Call GetPrivateProfileString(strSectionName, strKeyName, "Not Found", _ 

StrRet, 5000, mstrFN) 
GetProfileString = TrimAtFirstNull(strRet) 

End Function 

'sets a value 

Public Sub WriteProfileString(ByVal strSectionName As String, _ 
ByVal StrKeyName As String, ByVal strKey Value As String) 

Call WritePrivateProfileString(strSectionName, strKeyName, strKeyValue, _ 
mstrFN) 

End Sub 
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' Lockedltem.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
END 

Attribute VB_Name = "Lockedltem" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mstrLockedFN As String 

Private mudtWord As MSWord 

Private mdocLockedltem As Document 

Private mudtltemType As ItemType 

Private mudtDeliveryMode As DeliveryMode 

Public Enum DeliveryMode 

dmCBT = 0 

dmPPT = 1 
End Enum 

Public Property Let LockedItemFileName(ByVal strNewValue As String) 

mstrLockedFN = strNewValue 
End Property 

Public Property Let WordInstance(ByVal udtNewValue As MSWord) 

Set mudtWord = udtNev^ Value 
End Property 

Public Property Get DeliveryModeQ As DeliveryMode 

DeliveryMode = mudtDeliveryMode 
End Property 
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Public Property Get ItemTypeQ As ItemType 

ItemType = mudtltemType 
End Property 

Public Function OpenLockedltemDocQ As Boolean 

Dim udtProgress As New Progress 

Call udtProgress Jnit(2, "Opening locked item...") 
udtProgress. Advance 

Set mdocLockedltem = mudtWord.WordApp.Documents.Open(mstrLockedFN) 

If mdocLockedltem.ProtectionXype o wdNoProtection Then 

Call mdocLockedItem.Unprotect("ItemEdit") 
End If 

OpenLockedltemDoc = AnalyzeLockedltem 
udtProgress.Advance 
End Function 

Public Sub CloseLockedltemDocQ 

mdocLockedltem.Close 

Clipboard.Clear 
End Sub 

Private Function AnalyzeLockedltemQ As Boolean 

' true if document is successfully analyzed 
AnalyzeLockedltem = True 

If mdocLockedltem.Tables.Count = 1 Then ' QC item 
mudtltemType = ptQuantComp 
If mdocLockedltem.Bookmarks. Count = 3 Then 

mudtDeliveryMode = dmPPT 
Else 

mudtDeliveryMode = dmCBT 
End If 
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Elself mdocLockedltem.ListParagraphs. Count = 2 Then * DS 
mudtltemType = ptDataSuff 
mudtDeliveryMode = dmCBT 

Elself mdocLockedltem.ListParagraphs. Count = 5 Then * SMC 
mudtltemType = ptStandardMC 
mudtDeliveryMode = dmCBT 

Elself mdocLockedItem.Bookmarks.Exists("prop_key") = True Then ' 
mudtltemType = ptStandardMC 
mudtDeliveryMode = dmPPT 

Else 

AnalyzeLockedltem = False 
End If 

End Function 

Public Sub ConvertCBTSMCItemO 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Converting SMC CBT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp. ActiveDocument 

Dim stemRange As Range 
Set StemRange = mdocLockedltem. Content 
stemRange.Find.Style = "Heading 2" 
stemRange.Find.Execute FindText:="Stem" 
StemRange. Start = stemRange.Start + 5 

Dim respRange As Range 
Set respRange = mdocLockedltem. Content 
respRange.Find. Style = "Heading 2" 
respRange.Find.Execute FindText:="Response" 

stemRange.End = respRange. Start - 1 
stemRange.Copy 

Dim destRange As Range 

Set destRange = tcaDoc.Bookmarks("steml").Range 
With destRange 
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* .Borders.Enable = False 
.Words(l).Delete Count:=6 
.Collapse 

.Paste 

.Style = wdStyleNormal 
' .Borders.Enable = True 
End With 

* destRange.Borders.Enable = False 

* destRange. Collapse 

* destRange.Delete 

* destRange.Paste 

' destRange.InsertParagraphAfler 

* destRange. Style = wdStyleNormal 

* destRange.Borders.Enable = True 

With destRange.ParagraphFormat.Borders 

.Enable = True 

.DistanceFromTop = 1 

.DistanceFromLeft = 4 

.DistanceFromBottom = 1 

.DistanceFromRight = 4 
End With 

If destRange.Borders.InsideLineStyle = True Then 

destRange.Borders.InsideLineStyle = wdLineStyleNone 
End If 

* tcaDoc.Bookmarks.Add Name:="steml Range :=destRange 

Dim nextRange As Range 
Dim Key As String 
Dim abcde As String 
abode = "ABCDE" 
Dim i As Integer 
Dim n As Integer 
n= 1 

Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ' 
Key = udtlF.GetProfileStringC'LockedltemData", "Key") 

udtProgress.Advance 

Dim tabchr As String 
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tabchr = Chr$(9) 
For i = 1 To 5 

Set respRange = mdocLockedltem.ListParagraphs(i). Range 
respRange.Copy 

If Key = Mid(abcde, i, 1) Then 

Set destRange = tcaDoc.Bookmarks("Key").Range 
Else 

Set destRange = tcaDoc.Bookmarks("resp" & Format(n)).Range 
n = n+ 1 
End If 

With destRange 

.Borders.Enable = False 

.Words(l).Delete 

.Collapse 

.Paste 

.Style = wdStyleNormal 
.Borders.Enable = True 

If . Words(l).Text = tabchr Then 

.Words(l).Delete 
End If 

.Words(destRange.Words.Count).Delete 
End With 

Next 

udtProgress. Advance 
End Sub 

Public Sub ConvertPPTSMCItemQ 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Converting SMC PPT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp.ActiveDocument 
Dim stemStart As Long 
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10 



Dim destRange As Range 

Set destRange = tcaDoc.Bookniarks("stemr').Range 
stemStart = destRange.Stait 

Dim stemRange As Range 

Set StemRange = mdocLockedItem.Bookmarks("itemnum").Range 
StemRange. Start = stemRange. Start + 1 
Set StemRange = mdocLockedltem. Content 
stemRange.Find.Style = "PPTStimulus" 

If stemRange.Find.Execute Then 
StemRange. Copy 
destRange.Paste 

destRange.Collapse Direction:=wdCollapseEnd 
End If 



Set StemRange = mdocLockedltem.Content 
1 5 StemRange.Find.Style = "PPTStem" 

jp., StemRange.Find.Execute 
^ StemRange. Copy 

Qi destRange.Paste 
m destRange. Style = wdStyleNormal 

=?" 

destRange.Start = stemStart 
destRange.Borders.Enable = True 

With destRange.ParagraphFormat.Borders 
.Enable = True 
.DistanceFromTop = 1 
25f ' .DistanceFromLeft 4 

.DistanceFromBottom = 1 
.DistanceFromRight = 4 
End With 

If destRange.Borders.InsideLineStyle = True Then 
30 destRange.Borders.InsideLineStyle = wdLineStyleNone 

End If 



35 



tcaDoc.Bookmarks.Add Name:="stemr', Range :=destRange 

Dim nextRange As Range 
Dim respRange As Range 
Dim Key As String 
Dim abode As String 
abcde = "ABCDE" 
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Dim i As Integer 
Dim n As Integer 
n=l 

Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ' 
Key = udtlF.GetProfileStringC'LockedltemData", "Key") 

udtProgress.Advance 

For i = 1 To 5 

Set respRange = mdocLockedltem.Content 
respRange.Find. Style = "PPTOptions" 
respRange.Find.Execute FindText:="(" & Mid(abcde, i, 1) & 
respRange. Start = respRange. Start + 4 

Set nextRange = mdocLockedltem.Content 

Ifi<5Then 

nextRange.Find. Style = "PPTOptions" 

nextRange.Find.Execute FindText:="(" & Mid(abcde, i + 1, 1) & ")" 
Else 

nextRange.Find. Style = "ItemLabel" 
nextRange.Find.Execute FindText:="Scratch Pad" 
End If 

respRange.End = nextRange.Start - 1 
respRange.Copy 

If Key = Mid(abcde, i, 1) Then 

Set destRange = tcaDoc.Bookmarks("Key").Range 
Else 

Set destRange = tcaDoc.Bookmarks("resp" & Format(n)). Range 
n = n+ 1 
End If 

destRange.Words(l).Delete 

destRange.CoUapse 

destRange.Paste 

Next 

udtProgress.Advance 
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End Sub 



Public Sub ConvertDSItemO 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, '^Converting DS CBT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp. ActiveDocument 

Dim stemRange As Range 
Set StemRange = mdocLockedltem. Content 
stemRange.Find.Style = "Heading 2" 
stemRange.Find.Execute FindText:="Stem" 
stemRange.Start = stemRange. Start + 5 

Dim respRange As Range 

Set respRange = mdocLockedltem. Content 

respRange.Find.Style = "DataSuffStatement" 

respRange.Find.Execute 

StemRange. End = respRange. Start - 1 
stemRange.Copy 

Dim destRange As Range 

Set destRange = tcaDoc.Bookmarks("steml").Range 
destRange.Borders.Enable = False 
destRange. Collapse 
destRange.Paste 
' destRange.Borders.Enable = True 

With destRange.ParagraphFormat.Borders 

.Enable = True 

.DistanceFromTop = 1 

.DistanceFromLeft = 4 

.DistanceFromBottom = 1 

.DistanceFromRight = 4 
End With 

If destRange.Borders.HasHorizontal = True Then 

destRange.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone 
End If 

Dim Key As String 
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Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ".ini" 
Key = udtlF.GetProfileStringC'LockedltemData", "Key") 

Set destRange = tcaDoc.Bookmarks("Key").Range 
destRange.Words(l).Delete 
destRange.InsertBefore Text:=Key 

udtProgress.Advance 

Dim i As Integer 

For i = 1 To 2 

Set respRange = mdocLockedItem.ListParagraphs(i).Range 
respRange.Copy 

Set destRange = tcaDoc.Tables(i).Cell(Row:=l, Column:=l).Range 
destRange.Paste 

destRange. Style = wdStyleNormal 
Next 

udtProgress.Advance 
End Sub 

Public Sub ConvertCBTQCItemO 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Converting QC CBT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc ^ mudtWord.WordApp.ActiveDocument 
Dim stemRange As Range 

Set StemRange = mdocLockedItem.Tables(l).Cell(Row:=l, Column:=l). Range 
stemRange.Copy 

Dim destRange As Range 

Set destRange = tcaDoc.Bookmarks("steml").Range 
destRange.Borders. Enable = False 
destRange. Words(2).Delete 
destRange. Words(l). Delete 
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destRange.Collapse 
destRange.Paste 

tcaDoc.Tables(2).Rows.SetLeftIndent LeftIndent:=-0.6, RulerStyle:=wdAdjustNone 
tcaDoc.Tables(2).ConvertToText Separator:=wdSeparateByTabs 
destRange.Borders.Enable = True 

tcaDoc.Bookmarks.Add Name : ="s tern 1", Range :=destRange 

Dim Key As String 

Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & Mni" 
Key = udtIF.GetProfileString("LockedItemData", "Key") 

Set destRange = tcaDoc.Bookmarks("Key"). Range 
destRange.Words(l).Delete 
destRange.InsertBefore Text:=Key 

udtProgress.Advance 

Dim respRange As Range 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:=2, Column:=l).Range 
respRange. Copy 

Set destRange = tcaDoc.Bookmarks("columnA").Range 

destRange.Collapse 

destRange.Paste 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:=2, Colunin:=2).Range 
respRange.Copy 

Set destRange = tcaDoc.Bookmarks("columnB").Range 

destRange.Collapse 

destRange.Paste 

udtProgress.Advance 

End Sub 

Public Sub ConvertPPTQCItemO 
Dim udtProgress As New Progress 

Call udtProgress.Init(2, "Converting QC PPT locked item...") 
Dim tcaDoc As Document 

Set tcaDoc = mudtWord.WordApp.ActiveDocument 
Dim stemRange As Range 
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Set stemRange = mdocLockedItem.Tables(l).Cell(Row:=l, Column:=2).Range 
stemRange.Copy 

Dim destRange As Range 

Set destRange = tcaDoc.Bookniarks("stemr').Range 

destRange.Borders.Enable = False 

destRange. Words(2).Delete 

destRange.Words(l).Delete 

destRange.Collapse 

destRange. Paste 

tcaDoc.Tables(2).Rows.SetLeftIndent LeftIndent:=-0.6, RulerStyle:=wdAdjustNone 
tcaDoc.Tables(2).ConvertToText Separator:=wdSeparateByTabs 
destRange.Borders.Enable = True 

tcaDoc.Bookmarks.Add Namei-'steml", Range :=destRange 

Dim Key As String 

Dim udtIF As New IniFile 

udtlF.FN = IN_DIRECTORY & ExtractFileNameNoExt(mstrLockedFN) & ".ini" 
Key = udtlF.GetProfileStringC'LockedltemData", "Key") 

Set destRange = tcaDoc.Bookmarks("Key").Range 
destRange. Words( 1 ).Delete 
destRange. InsertBefore Text:=Key 

udtProgress. Advance 

Dim respRange As Range 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:=2, Column:=2).Range 
respRange. Copy 

Set destRange = tcaDoc.Bookmarks("columnA").Range 

destRange.Collapse 

destRange.Paste 

Set respRange = mdocLockedItem.Tables(l).Cell(Row:=2, Column:=4).Range 
respRange. Copy 

Set destRange = tcaDoc.Bookmarks("columnB").Range 

destRange.Collapse 

destRange.Paste 

udtProgress. Advance 

End Sub 
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' Model.cls 

VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
5 Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 
DataSourceBehavior = 0 VbNone 
MTSTransactionMode =0 'NotAnMTSObject 
END 

1 0 Attribute VB Name = "Model" 

Attribute VB_GlobalNameSpace = False 

Attribute VBCreatable = True 

Attribute VBPredeclaredId = False 

Attribute VB_Exposed = False 
1 5 Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" 

Attribute VB_Ext_KEY = "Top_Level" ,"No" 

Option Explicit 



Q 

01 



Q 



' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 



2Qs * enable i/o 

Private mudtFile As File 

^ ' handle for Model 

Private mdocModel As Document 

% ' the .doc file name of this model 
2^V Private mstrDocFN As String 



* the .mdl file name of this model 
Private mstrConFN As String 

' has this model produced variants that were accepted? 
Private mblnlsFrozen As Boolean 



30 * comments about this model 
^ Private mstrComments As String 

' all of the variables for this model 
Private mudtCVariables As CVariables 

* all of the constraints for this model 
# 35 Private mudtCConstraints As CConstraints 
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* all of the clones generated by this model 
Private mudtCClones As CClones 

* the collection of checksums accepted by this model (these persist) 
Private mcolChecksums As Collection 

' the collection of checksums accepted by this model (these don't persist) 
Private mcolTempChecksums As Collection 

' the Prolog object 

Private mudtProlog As Prolog 

' needed for I/O 

Private mblnProcessChecksums As Boolean 
' is dirty? 

Private mblnlsDirty As Boolean 

' needed to save the model one last time after it's frozen 
Private mblnFreeze As Boolean 

Private Enum ModelRecordLayout 

mrLocalDatalndex = 1 ' long (takes 4 bytes) 

mrVariablelndex = 5 ' long 

mrConstraintlndex = 9 ' long 

mrChecksumlndex = 13 ' * long 

mrLocalData = 51 ' byte 

mrVariables = 201 ' variable length 

' the constraint data starts vv^herever the checksum data ends 

' the checksum data starts v^herever the constraint data ends 
End Enum 

Private Sub Class_Initialize() 

Set mudtCVariables = New CVariables 

Set mudtCConstraints = New CConstraints 

Set mudtCClones = New CClones 

Set mcolChecksums = New Collection 

Set mcolTempChecksums = New Collection 

mblnlsDirty = True 

mblnFreeze = False 

End Sub 

Public Property Get FileName() As String 
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FileName = mstrDocFN 
End Property 

Public Property Let FileName(ByVal strNewValue As String) 

mstrDocFN = strNewValue 

5 ' create the FN for the constraint file 

mstrConFN = left(mstrDocFN, Len(mstrDocFN) - 4) & ".mdl" 

End Property 

Public Property Get IsFrozenQ As Boolean 
IsFrozen = mblnlsFrozen 
10 End Property 
55 Public Property Let IsFrozen(ByVal blnNewValue As Boolean) 
U1 mblnlsFrozen = blnNewValue 
W End Property 

Public Property Get CommentsQ As String 
1 5i^f Comments = mstrComments 
End Property 

Public Property Let Comments(ByVal strNewValue As String) 

If mstrComments o strNewValue Then 
mstrComments = strNewValue 
20 mblnlsDirty = True 

End If 

End Property 

Public Property Get ClonesQ As CClones 

Set Clones = mudtCClones 
End Property 
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Public Property Get VariablesQ As CVariables 

Set Variables = mudtCVariables 
End Property 

Public Property Get ConstraintsQ As CConstraints 

Set Constraints = mudtCConstraints 
End Property 
Public Sub FreezeModelQ 

If IsFrozen = False Then 

mblnFreeze = True 

IsFrozen = True 

WriteModel 
End If 

End Sub 

Public Sub AddChecksum(ByVal dblChecksum As Double) 

Call mcolChecksums.Add(dblChecksum) 
mblnlsDirty = True 

End Sub 

' resets the checksums if this model is a child 
Public Sub InitChecksumsQ 

Set mcolChecksums = New Collection 

End Sub 

Private Sub AddTempChecksum(ByVal dblChecksum As Double) 

Call mcolTempChecksums.Add(dblChecksum) 
End Sub 

' resets the temp checksums if this model is changed and variants are 
Public Sub InitTempChecksumsQ 
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Set mcolTempChecksums = New Collection 
End Sub 

Public Function ChecksumExists(ByVal dblChecksum As Double) As Boolean 
Dim vntChecksum As Variant 

' if no variables were checksummed, consider the variant unique 
If dblChecksum = 0 Then 

ChecksumExists = False 

Exit Function 
End If 

' check the persistent checksums (from accepted or discarded variants) 
For Each vntChecksum In mcolChecksums 
If vntChecksum = dblChecksum Then 
ChecksumExists = True 
Exit Function 
End If 
Next vntChecksum 

' check the checksums of variants produced in this session 
For Each vntChecksum In mcolTempChecksums 
If vntChecksum = dblChecksum Then 
ChecksumExists - True 
Exit Function 
End If 
Next vntChecksum 

ChecksumExists = False 

End Function 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 
Dim mblnSaved As Boolean 

' As frozen models never get saved, they report is dirty 
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' when they are read in from disk. This fix causes them 
' to always report not IsDirty. 

* If IsiFrozen Then 

* IsDirty = False 
' Exit Property 

' End If 

If mdocModel Is Nothing Then 

mblnSaved = True 
Else 

mblnSaved = mdocModel. Saved 
End If 

IfmblnlsDirty Or_ 
mudtCVariables.IsDirty Or _ 
mudtCConstraints.IsDirty Or _ 
mblnSaved = False Then 
IsDirty = True 

Else 

IsDirty = False 
End If 

End Property 

Public Property Let LastClone(ByVal intNew Value As Integer) 

mudtCClones.SeqNum = intNewValue 
End Property 

Public Property Get LastCloneQ As Integer 

LastClone = mudtCClones.SeqNum 
End Property 
' displays model 

Public Sub OpenDoc(ByVal udtWord As MSWord) 

Dim udtDS As New DocStatus 

' see if word doc is open 

If udtDS.IsOpen(mstrDocFN) = False Then 

Set mdocModel = udtWord.WordApp.Documents.Open(mstrDocFN, , mblnlsFrozen) 
End If 
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mdocModel. Activate 

End Sub 

' closes model 

Public Sub CloseDocQ 

' save the model and the word doc 
Call WriteModel 

Dim udtDS As New DocStatus 

' close the word doc 

If udtDS.IsOpen(mstrDocFN) Then 

Call mdocModel.Close(False) ' don't save 

Set mdocModel = Nothing 
End If 

End Sub 

Public Sub CloseAUCloneDocsO 

Dim udtClone As Clone 

For Each udtClone In mudtCClones 

udtClone. CloseDoc 
Next udtClone 

End Sub 

Public Sub ReadModelO 

Dim udtWAPI As New Win32API 

If udtWAPLFileExists(mstrConFN) Then 
Set mudtFile = New File 
mudtFile.FileName = mstrConFN 
mblnProcessChecksums = False 

Call mudtFile.ReadFile(Me, mrLocalDatalndex, mrVariablelndex) 
Call mudtCVariables.ReadCollection(mstrConFN, mrVariablelndex, mrConstraintlndex) 
Call mudtCConstraints.ReadCollection(mstrConFN, mrConstraintlndex, 
mrChecksumlndex) 

mblnProcessChecksums = True 

Call mudtFile.ReadFile(Me, mrChecksumlndex, READ_UNTIL_EOF) 
Set mudtFile = Nothing 
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End If 



End Sub 

Public Sub ReadObjectsO 

Dim vField As Variant 

If mblnProcessChecksums Then 
On Error GoTo Beatit 
Do Until err.Number o 0 

Call mudtFile.ReadField(vField) 
Call mcolChecksums.Add(vField) 
Loop 
Else 

Call mudtFile.ReadField(vField) ' returns the version stamp 
Call mudtFile.ReadField(vField) 
LastClone = vField 
Call mudtFile.ReadField(vField) 
IsFrozen = vField 
Call mudtFile.ReadField(vField) 
Comments = vField 
End If 

Beatit: 

Exit Sub 

End Sub 

Public Sub WriteModelO 

Dim IngEndPos As Long 
Dim udtDS As New DocStatus 
Dim udtProg As New Progress 

If IsDirty = False Then Exit Sub 

' If IsFrozen And mblnFreeze = False Then Exit Sub 

Call udtProg.Init(2, "Saving the active model...") 

If udtDS.IsC)pen(mstrDocFN) Then ' see if word doc is open 

If Not IsFrozen Then ' command will fail if doc is read-only 
mdocModel.Save 

End If 
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End If 

Set mudtFile = New File 
mudtFile.FileName = mstrConFN 
mblnProcessChecksums = False 

Call mudtFile. WriteFile(Me, True, mrLocalDatalndex, mrLocalData) 
udtProg.Advance 

IngEndPos = mudtCVariables,WriteCollection(mstrConFN, mrVariablelndex, mrVariables) 
IngEndPos = mudtCConstraints.WriteCollection(mstrConFN, mrConstraintlndex, IngEndPos) 
mblnProcessChecksums = True 

Call mudtFile. WriteFile(Me, False, mrChecksumlndex, IngEndPos) 

Set mudtFile = Nothing 

udtProg.Advance 

IsDirty = False 

mblnFreeze = False 

End Sub 

Public Sub WriteObjectsQ 
Dim vntChecksum As Variant 

If mblnProcessChecksums Then 

For Each vntChecksum In mcolChecksums 
Call mudtFile. WriteField(vntChecksum) 

Next vntChecksum 
Else 

Call mudtFile.WriteField(mintVERSIONSTAMP) 
Call mudtFile.WriteField(LastClone) 
Call mudtFile.WriteField(IsFrozen) 
Call mudtFile.WriteField(Comments) 
End If 

End Sub 

* tests the constraints, doesn't care about unique solution 

Public Function ConstraintsOK(ByVal udtTestType As TestType, _ 
ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 
blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

Dim strVN As String 
Dim strVal As String 

Dim udtCS As Constraints olver 

Set udtCS = InitConstraintSolver(2, udtTestType) 
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udtCS.Prolog = udtProlog 

blnUndercons trained = False 
blnTestAborted = False 

Select Case udtCS.Solve(srTest) 
Case srPrologError, srNoSolutions 

ConstraintsOK = False 

Exit Function 
Case srPrologAborted 

blnTestAborted = True 

ConstraintsOK = False 

Exit Function 
Case srSuccess 

Do While udtCS.GetNextValue(strUndercons trained VN, strVal) 
If strVal = Then ' it's underconstrained 
ConstraintsOK = False 
blnUnderconstrained = True 
Exit Function 
End If 
Loop 
End Select 

ConstraintsOK = True 
End Function 

' implemented in the subclasses of Model 

Public Sub GenerateClones(ByVal udtWord As MSWord, ByVal udtProlog As Prolog, 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

End Sub 

* common code called by GenerateClones in the subclasses 

Public Sub Substitute Values(ByVal objO As Object, _ 

ByVal udtWord As MSWord, ByVal udtProlog As Prolog, _ 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, _ 
ByVal intStartPos As Integer) 

Dim udtClone As Clone 

Dim strPath As String 

Dim fRange As Range 

Dim intlndex As Integer 

Dim udtCS As ConstraintSolver 
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Dim udtSortedVs As CVariables 

Dim udtCon As Constraint 

Dim strVarName As String 

Dim strValue As String 

Dim intTry As Integer 

Dim blnSolFound As Boolean 

Dim blnUniqueSolFound As Boolean 

Dim udtType As VariableType 

CloseDoc ' close the model doc 

CommandBars('Tile").Controls("Exit").Enabled = False 
Randomize 

' do substitution of values into model doc 
strPath = ExtractPath(FileName) 
Dim udtProgress As New Progress 

Call udtProgress.Init(intNumClones, "Generating variants... 

* initalize the constraint solver 

Set udtCS = InitConstraintSolver(bytDifference) 

udtCS.Prolog - udtProlog 

' solve loop 

For intlndex = 1 To intNumClones 

' try lOx to get a unique sol, then give up 
ForintTry = 1 To 10 
DoEvents ' allow abort 
If frmProlog. Abort Then 

Exit Sub 
End If 

blnSolFound = False 

blnUniqueSolFound = False 

If udtCS.Solve(srGenerate) Then ' found a variant 

blnSolFound = True 
Else 

Exit For 
End If 

' variant found - is it unique? 

If Not ChecksumExists(udtCS. Checksum) Then 

blnUniqueSolFound = True 

Exit For 
End If 
Next intTry 
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' error if no solution found 
If Not blnSolFound Then 

Call MsgBox("No solution could be found for this constraint set", _ 
vbExclamation, "Error") 
' udtProgress.Kill 
Exit Sub 
End If 

' error if unique solution could not be found 
If Not blnUniqueSoIFound Then 

Call MsgBox("A unique solution could not be found for this constraint set after 10 
attempts." & _ 

" You may want to try again.", vbExclamation, "Error") 
' udtProgress.Kill 
Exit Sub 
End If 

* add the new clone to the collection 

Set udtClone = Clones.Add(ExtractFileName(FiIeName), True) 

udtClone.Checksum = udtCS.Checksum 

Call AddTempChecksum(udtClone. Checksum) 

' add the new clone to the disposition list box 

With frmTCA.lstDisposition 

Call .Addltem(udtClone.FileName) 

.IteniData(.ListCount - 1) = udtClone. index 
End With 

FileCopy FileName, strPath & udtClone.FileName 
Call udtClone.OpenDoc(udtWord, strPath) 
' do the substitution 

Set fRange = udtClone.CloneDoc.Content 
fRange. start = intStartPos 

With fRange. find 

While udtCS.GetNextValue(strVarName, strValue) 
.ClearFormatting 
.Text = strVarName 
.Replacement. ClearFormatting 

.Replacement. Text = FormatValue(strVarName, strValue) 
' this first execute needed so Word returns correct value 
.Execute replacei^wdReplaceAll, Forward:=True, _ 
MatchCase:=True 
Wend 
End With 

Dim i, n As Integer 
Dim nShapes As Long 
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n = udtClone.CloneDoc.InlineShapes.Count 



For i = 1 To n 

udtCS .ResetValuelndex 

While udtCS.GetNextValue(strVarName, strValue) 

udtClone.CloneDoc.InlineShapes(i). Select 

Call MTTextSubstitution(strVarName, strValue) 
Wend 
Next 

udtClone.CloneDoc.Bookmarks("steml").Range.Copy 

If udtClone.CloneDoc.Bookmarks.Exists("tca_Stem") = True Then 
Dim stemRange As Range 

Set StemRange = udtClone.CloneDoc.Bookmarks("tca_Stem").Range 
stemRange.Paste 

udtClone.CloneDoc.Bookmarks.Add name:="tca_Stem", Range :=stemRange 
Else 

Call MsgBoxC'Model is missing TCA Stem Bookmark!", vbExclamation, "Hey!") 
End If 

' trim hard returns at end of stem 
Dim retchr As String 
retchr = Chr$(13) 

With StemRange 
n = 0 

i = .Words. Count 

While .Words(i).Text = retchr And i > 1 ' Rob: I added the And part. Pete 
i = i- 1 

If .Words(i).Text = retchr Then 

n = n+ 1 
End If 
Wend 

Ifn>OThen 

.Words(.Words.Count - n + l).Delete Count:=n 
End If 
End With 

' callback to subclass to code unique to this model type 
Call objO.CreateVariant(udtClone) 
udtProgress.Advance 
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udtClone.CloseDoc 
Next intlndex 

End Sub 

' create, initialize constraint solver 

Private Function InitConstraintSolver(ByVal bytDifference As Byte, _ 

Optional ByVal udtTestType As TestType = tcTestAU) As ConstraintSolver 

Dim udtVar As Variable 
Dim udtCon As Constraint 
Dim udtVarString As VarString 
Dim udtCS As New ConstraintSolver 
Dim udtSortedVs As CVariables 

* add enabled variables to ConstraintSolver object, sorted by length, 

* strings first 

Set udtSortedVs = mudtC Variables. SortVarNamesByLength 

For Each udtVar In udtSortedVs 

If udtVar.Enabled Then 

Call udtCS.AddVariable(udtVar) 

End If 
Next udtVar 

' Add enabled constraints 
For Each udtCon In Constraints 
If udtCon.Enabled Then 

If udtTestType - tcTestAll Or _ 

udtCon.ConstraintType = udtTestType - 1 Then 
Call udtCS.AddConstraint(udtCon) 
End If 
End If 
Next udtCon 

udtCS.Diff^Veight = bytDifference 
Set InitConstraintSolver = udtCS 
End Function 

' formats all math variables for item presentation 
Private Function FormatValue(ByVal strVarName As String, _ 
ByVal strValue As String) As String 
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Dim udtV As Variable 
Dim udtVR As VarReal 
Dim udtVF As VarFraction 

For Each udtV In mudtCVariables 
IfudtV.Enabled Then 

If udtV.name = ExtractVarName(strVarName) Then 
Select Case udtV.Typ 
Case vtlnteger 

FormatValue = strValue 
Case vtReal 

Set udtVR = udtV 

FormatValue = FormatReal(strValue, _ 

udtVR.DecimalPlaces, udtVR.TrailingZeros) 
Case vtFraction 

Set udtVF - udtV 

If udtVF.MixedNumbers Then 

FormatValue = FormatFraction( strValue) 

Else 

FormatValue = strValue 
End If 
Case vtString 

FormatValue = strValue 
Case vtUntyped 

FormatValue = FormatUntyped(strValue) 
End Select 
Exit For 
End If 
End If 
Next udt V 

End Function 

' takes the index off of a string variable name that is indexed 

Private Function ExtractVarName(ByVal strName As String) As String 

Dim varl As Variant 

varl = InStr(l, strName, ".") 

IfvarI>OThen 

ExtractVarName = left(strName, varl - 1) 
Else 

ExtractVarName = strName 
End If 
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End Function 



' formats reals for item presentation 

Private Function FormatReal(ByVal strReal As String, By Val intPlaces As Integer, 
ByVal blnTZeros As Boolean) As String 

Dim varPos As Variant 

Dim intLen As Integer 

Dim strl As String 

Dim strD As String 

Dim blnZeroFound As Boolean 

varPos = InStr(l, strReal, ".") 

' isolate strings on either side of decimal point 
IfvarPos = OThen 

strl = StrReal 
Else 

strl Mid(strReal, 1, varPos - 1) 
StrD = Mid(strReal, varPos + 1, Len(strReal)) 
End If 

intLen = Len(strD) 

' pad or trim to intPlaces 
If intLen < intPlaces Then 

StrD = StrD & String(intPlaces - intLen, "0") 
Else 

If intLen > intPlaces Then 

StrD = left(strD, intPlaces) 
End If 
End If 

' get rid of trailing zeros if desired 
If blnTZeros = False Then 
Do 

blnZeroFound = False 
Ifright(strD, 1) = "0" Then 

StrD = left(strD, Len(strD) - 1) 

blnZeroFound = True 
End If 

Loop While blnZeroFound 
End If 

' reassemble string 
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IfLen(strD)>OThen 

FormatReal = strl & & strD 
Else 

FormatReal = strl 
5 End If 

End Function 

' formats fraction as mixed number for item presentation 

Private Function FormatFraction(By Val strFraction As String) As String 

Dim intNum As Integer 
1 0 Dim intDen As Integer 

Dim intQuot As Integer 
Dim vnti As Variant 

vnti = InStr(strFraction, 7") 

^ ' it's an integer 

1 5j5 If vnti = 0 Then ' it*s a whole number 
fll FormatFraction = strFraction 

Ul Exit Function 

^ End If 

=lf intNum = CInt(left(strFraction, vnti - 1)) 

20^=^ intDen = CInt(right(strFraction, Len(strFraction) - vnti)) 

; ; 

% If intDen > 0 And Abs(intNum) > intDen Then 

intQuot = Int(intNum / intDen) 
il intNum = intNum Mod intDen 

m FormatFraction = Trim(Str(intQuot)) & " " & Trim(Str(Abs(intNum))) & 7" & 

2§i Trim(Str(intDen)) 
Else 

FormatFraction = strFraction 
End If 

End Function 

30 Private Function FormatUntyped(ByVal strValue As String) 
Dim varl As Variant 

' see if the value is a Hst - if so, it will be in [] 
If left(strValue, 1) = And right(strValue, 1) = Then 
' trim the brackets off 
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FormatUntyped = Mid(strValue, 2, Len(strValue) - 2) 
Else 

FormatUntyped = strValue 
End If 

End Function 

Private Function MTTextSubstitution(Source As String, dest As String) 
Dim Stat 

Selection.Copy 

'Init API, reset transform 

If MTUtiLCheckMTDLLVersion = 0 Then Exit Function 
MTXFormReset 

'first substitution 
Stat = MTXFormAddVarSub( _ 
mtxfmSUBST_ALL, _ 

mtxfmVAR_SlJB_PLAIN_TEXT, Source, 0, _ 

mtxfmVAR_SUB_PLAIN_TEXT, dest, Len(dest), mtxfinSTYLE_NUMBER) 

If Stat oO Then 

MsgBox "MTXFormAddVarSub returned: " + Str(stat) 

Exit Function 
End If 

*do the substitution 

Stat = TransformGraphicEquation 

IfstatoOThen 

MsgBox "TransformGraphicEquation returned: " + Str(stat) 

Exit Function 
End If 

MTTermAPI 
Selection.Delete 
'Paste new equation 

Selection.CoUapse Direction:=wdCollapseEnd 
Selection.PasteSpecial Placement:=wdInLine 

End Function 
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' PrintModel.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
END 

Attribute VB_Name = "PrintModel" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mstrModelName As String 
Private mstrNow As String 
Private mintPage As Integer 
Private mintTab As Integer 

Public Property Let ModelName(ByVal strNewValue As String) 

mstrModelName = strNewValue 
End Property 

Public Sub PrintString(ByVal strS As String, ByVal intlndent As Integer) 
CheckPageBreak 

If Printer. CurrentY = 0 Then PrintHeading 
Printer.Print Space(intlndent * mintTab) & strS 
End Sub 

Private Sub PrintHeading() 

Dim intY As Integer 

Printer. CurrentY = 1440 ' top margin 
Printer.Print Space(mintTab) & _ 

"Variables and constraints for model " & mstrModelName 
Printer.Print Space(mintTab) & mstrNow 
Printer.CurrentY = Printer. CurrentY + 100 
Printer.Line Step(0, 0)-Step(Printer. Width, 0) 
SkipLine 
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intY = Printer. CurrentY 
Printer.CurrentY = Printer.Height - 1700 
Printer.Line Step(0, 0)-Step(Printer. Width, 0) 
Printer.CurrentY = Printer.CurrentY + 100 
Printer.CurrentX = 0 

Printer.Print Space(mintTab) & "Page " &, Str(mintPage) 
Printer.CurrentY = intY 
mintPage = mintPage + 1 

End Sub 

Private Sub SkipLine() 

Printer.Print " " 
End Sub 

Private Sub CheckPageBreak() 

Select Case Printer.PaperSize 
Case vbPRPSLetter, vbPRPSLetterSmall 

Call CheckOrientation(8.5, 11) 
Case vbPRPSTabloid 

Call CheckOrientation(ll, 17) 
Case vbPRPSLedger 

Call CheckOrientation(17, 11) 
Case vbPRPSLegal 

Call CheckOrientation(8.5, 14) 
End Select 

End Sub 

Private Sub CheckOrientation(ByVal sng Width As Single, 
ByVal sngHeight As Single) 

' convert inches to twips 
sng Width = sngWidth * 1440 
sngHeight = sngHeight * 1440 

If Printer.Orientation = vbPRORPortrait Then 
If Printer.CurrentY >= sngHeight - 2200 Then 

Printer.NewPage 
End If 

Else 

If Printer.CurrentY >= sngWidth - 2200 Then 
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Printer.NewPage 
End If 
End If 

End Sub 

Private Sub Class_Initialize() 

Printer.FontSize =11 
mstrNow = Now 
mintPage = 1 
mintTab = 4 

End Sub 

Private Sub Class_Terminate() 
Printer. EndDoc 



End Sub 



* Progress. els 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l 'True 
END 

Attribute VB_Name = "Progress" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
' class to give visual indication of progress 
Option Explicit 

Private mintStepSize As Integer 
' pulls up form 

Public Sub Init(ByVal intNumlncrements As Integer, _ 
Optional ByVal strCaption As String) 

If intNumlncrements = 0 Then * prevent divide by 0 

Beep 

Exit Sub 
End If 

mintStepSize = 500 / intNumlncrements 

frmProgress.prbProgressBar.Max = mintStepSize * intNumlncrements 

If Len(strCaption) > 0 Then 

frmProgress.lblProgress = strCaption 
End If 

fhnProgress . Show 
frmProgress.Refresh 

End Sub 

* bumps the progress bar to the next increment. When the progress 

* bar is fiilly advanced, the form is unloaded. 
Public Sub AdvanceQ 

Dim intStop As Integer 

With frmProgress.prbProgressBar 
If .Value = .Max Then 
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Exit Sub 
End If 

intStop = .Value + mintStepSize 
Do Until .Value = intStop 
.Value = .Value + 1 
If .Value = .Max Then 
Unload frmProgress 
Exit Sub 
End If 
Loop 
End With 

End Sub 

Public Sub AbsoluteAdvance(By Val intNewValue As Integer) 

fimProgress.prbProgressBar. Value = intNewValue * mintStepSize 
End Sub 

Public Sub KillQ 

Unload frmProgress 
End Sub 
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' Prolog.cls 

VERSION 1.0 CLASS 
BEGIN 

Multiuser 0 'False 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 

DataSourceBehavior =0 VbNone 

MTSTransactionMode =0 'NotAnMTSObject 
END 

Attribute VB_Name = "Prolog" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = True 

Attribute VB_Ext_KEY = " Saved WithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 
Option Explicit 

Private Declare Function StartProlog4Session Lib "prighlapi.dll" _ 

(By Val strP4FN As String) As Long 
Private Declare Function EndProlog4Session Lib "prighlapi.dll" () As Long 
Private Declare Function GetHLAPIVersion Lib "prighlapi.dll" () As String 
Private Declare Function VBGetHLAPIVersion Lib "prighlapi.dll" () As String 
Private Declare Function SolveConstraintOrdered Lib "prighlapi.dll" _ 

(ByVal Constraint As String, ByVal SolutionOrder As Long) As Long 
Private Declare Function SolveConstraintRandomly Lib "prighlapi.dll" _ 

(ByVal Constraint As String) As Long 
Private Declare Function SolveConstraintOrderedNSolns Lib "prighlapi.dll" _ 

(ByVal Constraint As String, ByVal SolutionOrder As Long, _ 

ByVal NumSols As Long) As Long 
Private Declare Function IsFuUyConstrained Lib "prighlapi.dll" _ 

(ByVal Constraint As String) As Long 
Private Declare Function GetValue Lib "prighlapi.dll" _ 

(ByVal strVarName As String) As Long 
Private Declare Function VBGetValue_string Lib "prighlapi.dll" _ 

(ByVal udtPtr As Any) As String 
Private Declare Function VBPrintAUVarVals Lib "prighlapi.dll" () As String 
Private Declare Function SetSolnDiffWt Lib "prighlapi.dll" _ 

(ByVal Weight As Long) As Long 
Private Declare Function SetProloglnterruptFile Lib "prighlapi.dll" _ 

(ByVal strFN As String) As Long 

'Keep the constants in sync with appropriate values in prlghlapi.h 
' Solution-Orders: 
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Private Enum PrologOrder 

prDontCareOrder = 0 

prDifferentOrder= 10 

prLikeOrder = 20 

prRandomOrder = 30 

prUniqueOrder = 40 
End Enum 

Private Enum PrologType 

prValUnknown = 0 

prVallnteger = 10 

prValRationalFloat= 12 

prValRationalFraction =13 

prVallrrational =14 

prValReal=15 

prValString - 20 

prValList = 25 

prValFunctor = 30 

prValSymbol = 35 

prValVar= 100 
End Enum 

Private Enum PrologErrors 

prErrlnitialization = -10 

prErrlntegerraintTooLong = -15 

prErrGettingTerm = -20 

prErrMakingFunctor = -25 

prErrlnvalidlnterval = -30 

prErrArityTooMany = -35 

prErrParse = -40 

prErrNullTemi = -45 
End Enum 

' used to hold all strings for the Prolog 
Private mcolVNs As Collection 

Private mstrDelimit As String 

Private mintNumSols As Integer 

Event Finished(ByVal IngRet As Long) 

Private Sub Class_Initialize() 

Set mcolVNs = New Collection 



Set gProlog = Me ' gProlog is defined in Timer.bas 
Dim IngRet As Long 

' if this file exists, interrupt prolog processing 
IngRet = SetPrologInterruptFile("c:\halt.tca") 

End Sub 

Private Sub Class_Terminate() 

Set gProlog = Nothing 
End Sub 

Public Property Get Version() As String 

Version = GetHLAPIVersionQ 
End Property 

' sets the degree of difference in the variants. Range is 0 to 2. 
Public Property Let DiffWeight(ByVal bytDifference As Byte) 

Call SetSolnDiffWt(CLng(bytDifference)) 

End Property 

Public Function StartPrologQ As Boolean 

ChDir App.Path ' set path to application dir for hlp41ib.p4 file 
StartProlog = CBool(StartProlog4Session("hlp41ib.p4")) 

End Function 

Public Function EndPrologQ As Boolean 

ChDir App.Path ' set path to application dir for hlp41ib.p4 file 
EndProlog = CBool(EndProlog4Session()) 

End Function 

Public Sub AddVariable(ByVal strS As String) 
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If Len(strS) > 0 Then ' it's not an untyped variable 

Call mcolVNs.Add(strS) 

mstrDelimit = "end_var_defs," 
End If 

End Sub 

Public Sub AddConstraint(ByVal strS As String) 

Call mcolVNs.Add(mstrDelimit & strS) 
mstrDelimit = 

End Sub 

Public Sub SolveConstraintsRandomlyO 

SolveAsync ' in Timer.bas - must be in a standard module 
End Sub 

Public Sub SolveConstraintsAsyncQ 

Dim strS As String 
Dim IngRet As Long 

IngRet = -1 ' default to error condition 

If mcolVNs. Count > 0 Then ' there's something for Prolog to chew 
StrS = BuildStringO 

ChDir App.Path ' set path to application dir for hlp41ib.p4 file 
hagRet = SolveConstraintRandomly(strS) ' call Prolog 
End If 

RaiseEvent Finished(lngRet) 
Set mcolVNs = New Collection 
End Sub 

Private Function RandomNumSolsQ As Integer 
Randomize 

RandomNumSols = 10 * Rnd - 0.5 

If RandomNumSols = 0 Then RandomNumSols = 1 
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End Function 

Private Sub Advance(ByVal IngRet As Long) 

Dim inti As Integer 

5 For intI = 1 To IngRet 

NextSolution 
Next intI 

End Sub 

10 * gets the next solution, returns true if one exists, false if it doesn't 
Private Function NextSolutionQ As Boolean 

ChDir App.Path ' set path to application dir for hlp41ib.p4 file 
NextSolution = SolveConstraintOrderedNSolns(vbNullString, _ 
prUniqueOrder, mintNumSols) 

% End Function 

m Public Property Get PrintAllValsQ As String 
4j PrintAUVals = VBPrintAllVarVals 

200 End Property 

3 

' get the values associated with each solution 
Public Property Get Value(By Val strVN As String) As String 



s , 



Dim IngPtr As Long 
2^ Dim strT As String 

ChDir App.Path ' set path to application dir for hlp41ib.p4 file 
IngPtr = GetValue(strVN) * returns a pointer to the variable 

30 If IngPtr Then ' to handle untyped variables that have no constraint, and therefore no value 

StrT = VBGetValue_string(lngPtr) ' returns a string 

Value = Left(strT, Len(strT) - 1) ' trim off the null delimiter 
Else 
Value = 
35 End If 

End Property 



VBSCA -390- 



Private Function BuildStringQ As String 

Dim varStr As Variant 
Dim strS As String 

For Each varStr In mcolVNs 
5 strS = strS & varStr & " 

Next varStr 

* trim off the last comma and space 
strS = Left(strS, Len(strS) - 2) 
10 * add a period 

strS = strS&"." 

BuildString = strS 

1 5 End Function 

Public Sub ShowStringO 

Dim strS As String 

jf StrS = BuildStringO 
2QJi ' Call MsgBox(strS, , "Prolog string is:") 

J3 End Sub 
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' PSMODEL.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -1 'True 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 

DataSourceBehavior = 0 VbNone 

MTSTransactionMode = 0 'NotAnMTSObject 
END 

Attribute VB_Name = *'SMCModel" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Implements Model 

Dim mudtModel As Model 
Dim lastStart As Integer 

Private Sub Class_Initialize() 

Set mudtModel = New Model 

End Sub 

' Delegated to Class Model 

Public Property Get Model_FileName() As String 

Model_FileName = mudtModel.FileName 

End Property 

' Delegated to Class Model 

Public Property Let Model_FileName(ByVal strNewValue As String) 

mudtModel.FileName = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_IsFrozen() As Boolean 
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Model_IsFrozen = mudtModel.IsFrozen 
End Property 

' Delegated to Class Model 

Public Property Let Model_IsFrozen(ByVal blnNewValue As Boolean) 

mudtModelJsFrozen = blnNewValue 
End Property 

* Delegated to Class Model 

Public Sub Model_AddChecksum(ByVal dblChecksum As Double) 

Call mudtModel.AddChecksum(dblChecksum) 
End Sub 

' Delegated to Class Model 

Public Sub Model_InitChecksums() 

mudtModel.InitChecksums 

End Sub 

' Delegated to Class Model 

Public Sub Model_InitTempChecksums() 

mudtModeLInitTempChecksums 

End Sub 

' Delegated to Class Model 

Public Function Model_ChecksumExists(ByVal dblChecksum As Double) As Boolean 

Model_ChecksumExists = mudtModel.ChecksumExists(dblChecksum) 
End Function 
' Delegated to Class Model 

Public Property Get Model_Coniments() As String 

Model_Comments = mudtModel. Comments 
End Property 
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* Delegated to Class Model 

Public Property Let Model_Comxnents(ByVal strNewValue As String) 

mudtModel.Comments = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Clones() As CClones 

Set Model_Clones = mudtModel. Clones 

End Property 

' Delegated to Class Model 

Public Property Get Model_Variables() As CVariables 

Set Model_Variables = mudtModel. Variables 
End Property 

' Delegated to Class Model 

Public Property Get Model_Constraints() As CConstraints 

Set ModelConstraints = mudtModel. Constraints 
End Property 

' Delegated to Class Model 

Public Property Let Model_IsDirty(ByVal blnNewValue As Boolean) 

mudtModel.IsDirty = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model lsDirtyQ As Boolean 

Model_IsDirty = mudtModel.IsDirty 

End Property 

' Delegated to Class Model 

Public Property Let Model_LastClone(ByVal intNewValue As Integer) 
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mudtModel.LastClone = intNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_LastClone() As Integer 
5 ModelLastClone = mudtModel.LastClone 

End Property 

' Delegated to Class Model 
Public Sub Model_FreezeModel() 

Call mudtModel.FreezeModel 

10. End Sub 

' Delegated to Class Model 

Public Sub Model_OpenDoc(Byyal udtWord As MSWord) 



•SIS' 

: ; ; 



Call mudtModel.OpenDoc(udtWord) 
End Sub 



1 5f;3 • Delegated to Class Model 

Public Sub Model_CloseDoc() 

^ Call mudtModel.CloseDoc 

End Sub 

' Delegated to Class Model 
20 Public Sub Model_CloseAllCloneDocs() 

Call mudtModel.CloseAUCloneDocs 

End Sub 

' Delegated to Class Model 
Public Sub Model_ReadModel() 

25 mudtModel.ReadModel 

End Sub 
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' Delegated to Class Model 
Public Sub Model_ReadObjects() 

mudtModel . ReadObj ects 

End Sub 

* Delegated to Class Model 
Public Sub Model_WriteModel() 

mudtModel.WriteModel 

End Sub 

' Delegated to Class Model 
Public Sub Model_WriteObjects() 

mudtModel. WriteObj ects 

End Sub 

' Delegated to Class Model 

Public Function Model_ConstraintsOK(By Val udtTestType As TestType, _ 
ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 
blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

Model_ConstraintsOK = mudtModel. ConstraintsOK(udtTestType, udtProlog, _ 
blnUnderconstrained, blnTestAborted, strUnderconstrainedVN) 

End Function 

* implemented here 

Public Sub Model_GenerateClones(ByVal udtWord As MSWord, ByVal udtProlog As Prolog, 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

Call mudtModel. SubstituteValues(Me, udtWord, udtProlog, intNumClones, _ 
bytDifference, 50) 

End Sub 

' Delegated to Class Model 

Public Sub Model_SubstituteValues(ByVal objO As Object, _ 
ByVal udtWord As MSWord, ByVal udtProlog As Prolog, _ 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, _ 
ByVal intStartPos As Integer) 
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End Sub 



Public Sub CreateVariant(ByVal udtClone As Clone) 

With udtClone.CloneDoc.Bookmarks 
If .Exists("tca_RespA'0 = False Or _ 
.Exists("tca_RespB") = False Or _ 
.Exists("tca_RespC") = False Or _ 
.Exists("tca_RespD") = False Or _ 
.Existsnca_RespE") = False Or _ 
.Exists("tca_Key") = False Then 

Call MsgBoxC'Model is missing a TCA Bookmark!", vbExclamation, "Hey!") 
Exit Sub 
End If 
End With 

Dim nchoices As Integer 
Dim lowerbound As Integer 
Dim upperbound As Integer 

nchoices = 5 
lowerbound = 1 
upperbound - 8 

Dim resp(lO) As String 
Dim used(lO) As Integer 

resp(O) = udtClone. CloneDoc,Bookmarks("key").Range.Text 
Dim i As Integer 

For i = lowerbound To upperbound 
used(i) = 0 

resp(i) = udtClone. CloneDoc.Bookmarks("resp" & Fomiat(i)).Range.Text 
Next 

Dim nselected As Integer . 
nselected = 0 

Dim mumber As Integer 
Dim mumbers(lO) As Integer 

While (nselected < upperbound) 
mumber = (upperbound - lowerbound + 1) * Rnd + lowerbound - 0.5 
If (mumber > upperbound) Then 
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mumber = upperbound 
End If 

If (used(mumber) = 0) Then 

used(mumber) = 1 

nselected = nselected + 1 

mumbers(nselected) = mumber 
End If 
Wend 

Dim unsorted(lO) As Integer 
unsorted(O) = 0 
nselected = 0 

Dim j As Integer 
Dim n As Integer 

Dim crStr As String 
Dim tabcrStr As String 
crStr = Chr(13) 
tabcrStr = Chr(9)&Chr(13) 

For i = lowerbound To upperbound 
If resp(mumbers(i)) o tabcrStr And _ 
resp(mumbers(i)) o crStr And _ 
Mid(resp(mumbers(i)), 1, 10) <> "Distractor" Then 

n = 0 

For j = 0 To nselected 
If IsNumeric(resp(mumbers(i))) = True And _ 
IsNumeric(resp(unsorted(j))) = True And _ 
Asc(resp(mumbers(i))) o 36 Then ' 36 is the $ sign 
If Val(resp(mumbers(i))) = Val(resp(unsorted(j))) Then 
If Asc(resp(mumbers(i))) <> 1 Then 
n=l 
Exit For 
End If 
End If 
Else 

If resp(mumbers(i)) ^ resp(unsorted(j)) Then 
If Asc(resp(mumbers(i))) o 1 Then 
n=l 
Exit For 
End If 
End If 
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End If 
Next 

Ifn = OThen 
nselected = nselected + 1 
unsorted(nselected) = mumbers(i) 
If nselected = nchoices - 1 Then 
If nselected = upperbound Then 

Exit For 
End If 
End If 
End If 
Next 

For i = 0 To nselected 

used(i) = 0 
Next 

Dim sorted(lO) As Integer 
Dim respl, resp2 As String 
Dim vail, val2 As Variant 

For i = 0 To nselected 
For j = 0 To nselected 
If(usedG) = 0) Then 
sorted(i) = unsorted(j) 

n=j 
Exit For 
End If 
Next 

For j = 0 To nselected 
lf(used(j) = 0) Then 

respl = resp(unsorted(j)) 
resp2 = resp(sorted(i)) 

Ifleft(respl, 1) = "$" Then 

vail = Val(right(respl, Len(respl) - 1)) 
Else 

vail =Val (respl) 
End If 

Ifleft(resp2, 1) = "$" Then 
val2 = Val(right(resp2, Len(resp2) - 1)) 
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Else 

val2 = Val(resp2) 
End If 

If (vail < val2) Then 
5 sorted(i) = unsorted(j) 

n=j 
End If 

End If 
Next 

10 used(n) = 1 

Next 

For i = 0 To nselected 
Ifsorted(i) = OThen 
Exit For 
15. End If 

^ Next 



Dim min, max As Integer 



J=i min = i - 4 

If min < 0 Then 
2(^3 min = 0 

End If 



max = 1 

If max > nselected - 4 Then 
max = nselected - 4 



2±i; End If 

If max < 0 Then 

max = 0 
End If 

Dim i Start As Integer 
30 Dim iEnd As Integer 

If max > 0 And max + 4 <= nselected Then 
iStart = lastStart 
While iStart = lastStart 
iStart = (max - min + 1) * Rnd + min - 0.5 
35 Wend 
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lastStart = iStart 
iEnd = iStart + nchoices - 1 
Else 
iStart = 0 

If nselected > 4 Then 

iEnd = 4 
Else 

iEnd = nselected 
End If 

lastStart - iStart 
End If 

Dim respRange As Range 
Dim choice As String 
Dim key As String 

n=l 

For i = iStart To iEnd 
choice = Mid("ABCDE", n, 1) 

Ifsorted(i) = OThen 

udtClone.CloneDoc.Bookmarks("key").Range.Copy 
Else 

udtClone.CloneDoc.Bookmarks("resp" & Format(sorted(i))). Range. Copy 
End If 

Set respRange = udtClone.CloneDoc.Bookmarks("tca_Resp" & choice).Range 
respRange.Paste 

respRange.Borders. Enable = False 
respRange.Borders.InsideLineStyle = wdLineStyleNone 

udtClone.CloneDoc.Bookmarks.Add name:="tca_Resp" & choice, Range :=respRange 
respRange.InsertBefore Text:=choice & " 

Ifsorted(i) = OThen 

key = choice 

udtClone.key = choice 
End If 

n = n+ 1 
Next 

For i = nselected + 1 To nchoices - 1 
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choice = MidC'ABCDE", i + 1, 1) 

Set respRange = udtClone.CloneDoc.Bookmarks("tca_Resp" & choice).Range 
respRange.Text = "[NO VALUE]" & ChT(13) & Chr(lO) 

udtClone.CloneDoc.Bookmarks Add name:="tca_Resp" & choice, Range:=respRange 
respRange.InsertBefore Text:=choice & " 
Next 

Dim keyRange As Range 

Set keyRange = udtClone.CloneDoc.Bookmarks("tca_Key").Range 
keyRange.InsertBefore Text""Key is " & key 

End Sub 
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' QCModel.cls 

VERSION 1.0 CLASS 

BEGIN 
MultiUse = -l True 
5 Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 VbNone 
DataSourceBehavior =0 VbNone 
MTSTransactionMode = 0 'NotAnMTSObject 

END 

1 0 Attribute VB_Name = "QCModel" 

Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 

1 5 Option Explicit 

Implements Model 
li Dim mudtModel As Model 
y=l Private Sub Class_Initialize() 
j] Set mudtModel = New Model 

20^1 End Sub 



' Delegated to Class Model 
Public Property Get Model_FileName() As String 

Model_FileName = mudtModel.FileName 

End Property 

25 ' Delegated to Class Model 

Public Property Let Model_FileName(ByVal strNew Value As String) 

mudtModel.FileName = strNewValue 

End Property 

' Delegated to Class Model 
30 Public Property Get Model_IsFrozenO As Boolean 

Model_IsFrozen = mudtModel.IsFrozen 
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End Property 

' Delegated to Class Model 

Public Property Let Model_IsFrozen(ByVal blnNewValue As Boolean) 

mudtModel.IsFrozen = blnNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Coniments() As String 

Model_Cormnents = mudtModel. Comments 
End Property 

' Delegated to Class Model 

Public Property Let Model_Comments(ByVal strNewValue As String) 

mudtModel.Comments = strNewValue 
End Property 

' Delegated to Class Model 

Public Property Get Model_Clones() As CClones 

Set Model_Clones = mudtModel. Clones 

End Property 

' Delegated to Class Model 

Public Property Get Model_Variables() As CVariables 

Set Model_Variables = mudtModel Variables 
End Property 

' Delegated to Class Model 

Public Property Get Model_Constraints() As CConstraints 

Set Model_Constraints = mudtModel. Constraints 
End Property 
'Delegated to Class Model 
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Public Sub Model_AddChecksum(ByVal dblChecksum As Double) 

Call mudtModel.AddChecksum(dblChecksum) 
End Sub 

' Delegated to Class Model 

Public Sub Model_InitChecksums() 

mudtModel , Init Checksums 

End Sub 

' Delegated to Class Model 

Public Sub Model_InitTempChecksums() 

mudtModel.InitTempChecksums 

End Sub 

'Delegated to Class Model 

Public Function Model_ChecksumExists(ByVal dblChecksum As Double) As Boolean 

Model_ChecksumExists = mudtModel . ChecksumExists(dblChecksum) 
End Function 
' Delegated to Class Model 

Public Property Let Model_IsDirty(ByVal blnNewValue As Boolean) 

mudtModel.IsDirty = blnNewValue 
End Property 

* Delegated to Class Model 

Public Property Get Model_IsDirty() As Boolean 

Model_IsDirty = mudtModel.IsDirty 

End Property 

' Delegated to Class Model 

Public Property Let Model_LastClone(ByVal intNewValue As Integer) 
mudtModel. Last Clone = intNewValue 
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End Property 

' Delegated to Class Model 
Public Sub Model_FreezeModel() 

Call mudtModel.FreezeModel 

End Sub 

* Delegated to Class Model 

Public Property Get Model_LastClone() As Integer 

Model_LastClone = mudtModel.LastClone 
End Property 

' Delegated to Class Model 

Public Sub Model_OpenDoc(ByVal udtWord As MSWord) 

Call mudtModel.OpenDoc(udtWord) 
End Sub 

* Delegated to Class Model 
Public Sub Model_CloseDoc() 

Call mudtModel.CloseDoc 

End Sub 

* Delegated to Class Model 

Public Sub Model_CloseAllCloneDocs() 

Call mudtModel.CloseAllCloneDocs 
End Sub 

* Delegated to Class Model 
Public Sub Model_ReadModel() 

mudtModel.ReadModel 

End Sub 

' Delegated to Class Model 
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Public Sub Model_ReadObjects() 

mudtModel.ReadObjects 
End Sub 

• Delegated to Class Model 
Public Sub Model_WriteModel() 

mudtModel.WriteModel 

End Sub 

' Delegated to Class Model 
Public Sub Model_WriteObjects() 

mudtModel.WriteObjects 

End Sub 

' Delegated to Class Model 

Public Function Model_ConstraintsOK(ByVal udtTestType As TestType, _ 
ByVal udtProlog As Prolog, blnUnderconstrained As Boolean, _ 
blnTestAborted As Boolean, strUnderconstrainedVN As String) As Boolean 

Model_ConstraintsOK = mudtModel.ConstraintsOK(udtTestType, udtProlog, _ 
blnUnderconstrained, blnTestAborted, strUnderconstrainedVN) 

End Function 

* implemented here 

Public Sub Model_GenerateClones(ByVal udtWord As MSWord, ByVal udtProlog As Prolog, 
ByVal intNumClones As Integer, ByVal bytDifference As Byte) 

Call mudtModeLSubstituteValues(Me, udtWord, udtProlog, intNumClones, _ 
bytDifference, 275) 

End Sub 

' Delegated to Class Model 

Public Sub Model_SubstituteValues(ByVal objO As Object, _ 
ByVal udtWord As MSWord, ByVal udtProlog As Prolog, _ 
ByVal intNumClones As Integer, ByVal bytDifference As Byte, _ 
ByVal intStartPos As Integer) 
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End Sub 

Public Sub CreateVariant(ByVal udtClone As Clone) 

Dim mumber As Integer 
Dim sLen As Integer 
5 Dim columnRange As Range 

Dim columnAValStr As String 
Dim columns ValStr As String 

With udtClone.CloneDoc 

mumber = .Tables(2).Rows. Count * Rnd + 0.5 
10 .Tables(2).Cell(Row:=mumber, Column:=l).Range.Copy 

columnAValStr = .Tables(2).Cell(Row:=mumber, Column:=2).Range.Text 

sLen = Len(columnAValStr) 
If sLen > 1 Then 
columnAValStr = left(columnAValStr, sLen - 1) 
l§i End If 

Hrj Set columnRange = .Bookmarks("tca_ColumnA").Range 

j^i columnRange.Paste 

4';! mumber = .Tables(3). Rows. Count * Rnd + 0.5 

43 .Tables(3).Cell(Row:=mumber, Column:=l).Range.Copy 

20 columnB ValStr = .Tables(3).Cell(Row:=mumber, Column:=2).Range.Text 

^ sLen = Len(columnB ValStr) 

If sLen > 1 Then 

columnB ValStr = left(columnB ValStr, sLen - 1) 
End If 



^7. 



25 Set columnRange = .Bookmarks("tca_ColumnB").Range 

columnRange.Paste 

If .Tables(l). Columns. Count = 4 Then ' fixes weird behavior if only 1 row in model 
.Tables(l).Cell(Row:=l, Column:=4).Delete 
.Tables(l).Cell(Row:=l, Column:=3).Delete 
30 End If 

Dim key As String 
Dim columnAValue 
Dim columnB Value 
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If IsNumeric(columnAValStr) = True And _ 
IsNumeric(columriBValStr) = True Then 

columnAValue = Val(columnAValStr) 
columnBValue = Val(columnBValStr) 

If columnAValue > columnBValue Then 
key = "A" 

Elself columnBValue > columnAValue Then 
key = "B" 

Elself columnAValue = columnBValue Then 

key = "C" 
End If 

End If 

End With 

Dim keyRange As Range 

Set keyRange = udtClone.CloneDoc.Bookmarks("tca_Key").Range 
Ifkey = "" Then 

keyRange.InsertBefore Text:='TCA cannot determine the key" 
Else 

keyRange.InsertBefore Text:="Key is " & key 
End If 

udtClone.key = key 
End Sub 
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' StringSolver.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = 0 'False 

Persistable = 0 *NotPersistable 

DataBindingBehavior = 0 VbNone 

DataSourceBehavior = 0 VbNone 

MTSTransactionMode = 0 'NotAnMTSObject 
END 

Attribute VB_Naine = "StringSolver" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Dim mudtVS As VarString 

Dim mcolValues As Collection 

Public Property Let String Variable(ByVal udtNewValue As VarString) 

Set mudtVS udtNewValue 
End Property 

Public Property Get RandomValueCoUectionQ As Collection 

Dim udtSS As Substring 
Dim strS As String 
Dim varS As Variant 

Set mcolValues = New Collection 

strS = mudtVS. StringCollection.Item(GetRandomlndex) 

If mudtVS.IsIndexed Then 

Set udtSS = New Substring 

udtSS.Delimiter = mudtVS. Delimiter 

udtSS.StringValue = strS 

For Each varS In udtSS.StringCollection 
Call mcolValues.Add(varS) 

Next varS 
Else 
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Call mcolValues.Add(strS) 
End If 

Set Random ValueCollection = mcolValues 
End Property 

Private Function GetRandomIndex() As Integer 
Dim inti As Integer 

inti - mudtVS.StringCollection.Count * Rnd + 0.5 

' Seems to produce an out-of-range value sometimes. 
' This will fix it. 
IfintK 1 Then inti = 1 

If inti > mudtVS.StringCollection.Count Then inti mudtVS.StringCollection. 
GetRandomlndex = inti 
End Function 
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10 



' StringSolverx.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l 'True 
END 

Attribute VB_Name = "StringSolver" 
Attribute VB_GlobalNameSpace = False 
Attribute VBCreatable = Trae 
Attribute VBPredeclaredId = False 
Attribute VBExposed = False 
Option Explicit 



14. 



Private mcolSV As Collection 
Private Sub Class_Initialize() 

Set mcolSV = New Collection 
End Sub 
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' SubString.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
END 

Attribute VB_Name = "Substring" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Private mstrDelimiter As String 
Private mstrString As String 
Private mcolStr As Collection 
Private Sub Class_Initialize() 

Set mcolStr = New Collection 
End Sub 

Public Property Let Delimiter(ByVal strNewValue As String) 

mstrDelimiter = strNewValue 
End Property 

' use this to convert a concatenated string to a collection 
Public Property Let StringValue(ByVal strNewValue As String) 

mstrString = strNewValue 

End Property 

' or use this to convert a collection to a concatenated string 

Public Property Let StringCollection(ByVal colNewValue As Collection) 

Set mcolStr = colNewValue 

End Property 
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' converts collection into concatenated string 
Public Property Get StringValueQ As String 

Dim varS As Variant 
Dim strS As String 

' build new string 

For Each varS In mcolStr 

strS = strS & varS & mstrDelimiter 
Next varS 

' trim last character 
IfLen(strS)>OThen 

String Value = left(strS, Len(strS) - 1) 
End If 

End Property 

' converts concatenated string into a collection 
Public Property Get StringCoUectionQ As Collection 

Dim colC As New Collection 
Dim inti As Integer 

For intI = 1 To NumSubStrings 

Call colC.Add(GetSubString(intI)) 
Next intI 

Set StringCoUection = colC 
End Property 

' returns the number of substrings in this string 
Public Property Get NumSubStringsQ As Integer 

Dim intD As Integer 
Dim intI As Integer 
Dim varS As Variant 

If Len(mstrString) = 0 Then 

NumSubStrings = 0 

Exit Property 
End If 

For intI = 1 To Len(mstrString) 
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If Mid(mstrString, intl, 1) = mstrDelimiter Then 

into = intD + 1 
End If 
Next inti 

NumSubStrings = intD + 1 
End Property 

Public Sub AddSubString(ByVal strNewValue As String) 

Call mcolStr.Add(strNewValue) 
End Sub 

' parses the substring from the string depending on intlndex 

Public Function GetSubString(ByVal intlndex As Integer) As String 

' see if index is valid for the current string 
If NumSubStrings < intlndex Then 

GetSubString = "" 

Exit Function 
End If 

' index into the string using delimiter 
Dim varll As Variant 
Dim varI2 As Variant 
Dim intCount As Integer 

varI2 = 0 

Do 

varll = varI2 

varI2 = InStr(varIl -I- 1, mstrString, mstrDelimiter) 
intCount = intCount + 1 
IfvarI2 = 0Then 

varI2 = Len(mstrString) + 1 
End If 

Loop Until intCount = intlndex 

GetSubString = Mid(mstrString, varll + 1, varI2 - varll - 1) 
End Function 
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* Value.cls 

VERSION 1.0 CLASS 
BEGIN 
Multiuser -1 True 
END 

Attribute VB_Name = "Value" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 

Dim mstrVariableName As String 

Dim mstrValue As String 

Dim mblnChecksum As Boolean 

Dim mstrPrologString As String 

Dim mudtVariableType As VariableType 

Public Property Get VariableNameQ As String 

VariableName - mstrVariableName 

End Property 

Public Property Let VariableName(ByVal strNewValue As String) 

mstrVariableName = strNewValue 
End Property 

Public Property Get ValueQ As String 

Value = mstrValue 
End Property 

Public Property Let Value(ByVal strNewValue As String) 

mstrValue = strNewValue 
End Property 

Public Property Get ChecksumQ As Boolean 
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Checksum = mblnChecksum 
End Property 

Public Property Let Checksum(ByVal blnNewValue As Boolean) 

mblnChecksum = bbNew Value 
End Property 

Public Property Get PrologStringQ As String 

PrologString = mstrPrologString 
End Property 

Public Property Let PrologString(ByVal strNewValue As String) 

mstrPrologString = strNewValue 
End Property 

Public Property Get VariableTypeQ As VariableType 

VariableType = mudtVariableType 
End Property 

PubUc Property Let VariableType(ByVal udtNewValue As VariableType) 

mudtVariableType = udtNewValue 
End Property 
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* VarFraction.cls 
VERSION 1.0 CLASS 
BEGIN 

Multiuser -1 True 
5 END 

Attribute VB_Name = " VarFraction" 
Attribute VBGlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VBPredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

* current version of data produced by this class 
1 5 ^ Const mintVERSIONSTAMP As Integer = 1 

Private mstrFromNum As String 
^ Private mstrFromDen As String 
%i Private mstrToNum As String 

Private mstrToDen As String 
2(|^ Private mstrByNum As String 
J3 Private mstrByDen As String 
s Private mblnMixedNumbers As Boolean 
Q Private mblnlslndependent As Boolean 

B Private Sub Class_Initialize() 

2^ Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 
End Sub 

' Delegated to Class Variable 
Public Property Get Variable_Name() As String 

Variable_Name = mudtVar.Name 
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End Property 

' Delegated to Class Variable 

Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name = RHS 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 

* Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ = mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar.Index 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Index(By Val IngNewValue As Long) 

mudtVar.Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar.Enabled 

End Property 

' Delegated to Class Variable 
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Public Property Let Variable_Enabled(ByVal RHS As Boolean) 

mudtVar.Enabled = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(ByVal RHS As Boolean) 

mudtVar.IsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar. Checksum = blnNewValue 
End Property 

Public Property Get FromNumerator() As String 

FromNumerator = mstrFromNum 
End Property 

Public Property Let FromNumerator(ByVal strNewValue As String) 

mstrFromNum = strNewValue 
mudtVar.IsDirty = True 
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End Property 

Public Property Get FromDenominatorQ As String 

FromDenominator = mstrFromDen 
End Property 

Public Property Let FroniDenominator(ByVal strNewValue As String) 

mstrFromDen = strNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get ToNumeratorQ As String 

ToNumerator = mstrToNum 
End Property 

Public Property Let ToNumerator(ByVal strNewValue As String) 

mstrToNum = strNewValue 
mudtVar.IsDirty - True 

End Property 

Public Property Get ToDenominatorQ As String 

ToDenominator = mstrToDen 
End Property 

Public Property Let ToDenominator(ByVal strNewValue As String) 

mstrToDen - strNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get ByNumeratorQ As String 
ByNumerator = mstrByNum 
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End Property 

Public Property Let ByNumerator(ByVal strNewValue As String) 

mstrByNum = strNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get ByDenominator() As String 

ByDenominator = mstrByDen 
End Property 

Public Property Let ByDenominator(ByVal strNewValue As String) 

mstrByDen = strNewValue 
mudtVar.IsDirty = Tnie 

End Property 

Public Property Get MixedNumbersQ As Boolean 

MixedNumbers = mblnMixedNumbers 
End Property 

Public Property Let MixedNumbers(ByVal blnNewValue As Boolean) 

mblnMixedNumbers = blnNewValue 
mudtVar.IsDirty = True 

End Property 

Public Property Get IsIndependentQ As Boolean 

Islndependent = mblnlslndependent 
End Property 

Public Property Let IsIndependent(ByVal blnNewValue As Boolean) 

mblnlslndependent = blnNewValue 
mudtVar.IsDirty = True 
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End Property 



Public Sub Update(ByVal strName As String, _ 

ByVal strFromN As String, ByVal strFromD As String, _ 

ByVal strToN As String, ByVal strToD As String, _ 

ByVal strByN As String, ByVal strByD As String, _ 

ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, 

ByVal blnMixedNumber As Boolean) 

Variable_Name = strName 
FromNumerator = strFromN 
FromDenominator = strFromD 
ToNumerator = strToN 
ToDenominator = strToD 
ByNumerator = strByN 
ByDenominator = strByD 
Islndependent = blnlslndependent 
Variable_Checksum = blnChecksum 
MixedNumbers = blnMixedNumber 

End Sub 



Public Function Variable_PrologFormat() As String 

Dim strl As String 

If mblnlslndependent Then 

strl = "fraction(" & mudtVar.Name & "),offgrid(" & _ 
mudtVar.Name & & _ 
mstrFromNum & 7" & mstrFromDen & "<=" & _ 
mudtVar.Name & "<=" & mstrToNum & 7" & _ 
mstrToDen & " step " & mstrByNum Sl 7" & mstrByDen & "]" 

Else 

strl = "fraction(" & mudtVar.Name & ")" 
End If 

Variable_PrologFormat = strl 
End Function 

Public Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strOpt As String 
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If mudtVar.Checksum Then 

strOpt = "(C," 
Else 

strOpt = "(c," 
End If 

If mblnMixedNumbers Then 

StrOpt = StrOpt & "M)," 
Else 

StrOpt = StrOpt & "m)," 
End If 

If mblnlslndependent Then 

strl = mudtVar.Name & strOpt & ": Fraction, " & _ 
mstrFromNum & 7" & mstrFromDen & " to " & _ 
mstrToNum & 7" & mstrToDen & " by " & _ 
mstrByNum & 7" & mstrByDen 

Else 

strl = mudtVar.Name & strOpt & ": Fraction" 
End If 

Variable_ScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFiIe As File) As VariableType 

Variable_ReadType = mudtVar.ReadType(udtFile) 
End Property 

Public Sub Variable_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' reads version stamp 
Call udtFile.ReadField(vField) 
mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar.Checksum = vField 
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Call udtFile.ReadField(vField) 
Islndependent = vField 

Call udtFile.ReadField(vField) 
FromNumerator = vField 

Call udtFile.ReadField(vField) 
FromDenominator = vField 

Call udtFile.ReadField(vField) 
ToNumerator = vField 

Call udtFile.ReadField(vField) 
ToDenominator = vField 

Call udtFile.ReadField(vField) 
ByNumerator = vField 

Call udtFile.ReadField(vField) 
ByDenominator = vField 

Call udtFile.ReadField(vField) 
MixedNumbers = vField 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 

Dim udtType As VariableType 

udtType = vtFraction 

Call udtFile.WriteField(udtType) 

Call udtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(mudtVar.Name) 

Call udtFile.WriteField(mudtVar.Enabled) 

Call udtFile.WriteField(mudtVar.Checksum) 

Call udtFile.WriteField(IsIndependent) 

Call udtFile.WriteField(FromNuinerator) 

Call udtFile.WriteField(FromDenominator) 

Call udtFile.WriteField(ToNuinerator) 

Call udtFile.WriteField(ToDenominator) 

Call udtFile.WriteField(ByNumerator) 

Call udtFile.WriteField(ByDenominator) 

Call udtFile.WriteField(MixedNumbers) 
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mudtVar.IsDirty = False 
End Sub 

' makes a copy of this object 
5 Public Function Variable_Copy() As Variable 

Dim udtVF As New VarFraction 
Dim udtV As Variable 



10 



15 

C3 



Set udtV = udtVF 

udtV.Name = mudtVar.Name 
udtV.Enabled = mudtVar.Index 
udtV.IsDirty mudtVar.IsDirty 
udtV.Checksum = mudtVar. Checksum 



udtVF.FromNumerator = FromNumerator 
udtVF .FromDenominator = FromDenominator 
M udtVF.ByNumerator = ByNumerator 
Hi udtVF.ByDenominator = ByDenominator 
20|: udtVF.ToNumerator = ToNumerator 

udtVF.ToDenominator = ToDenominator 
J" udtVF.IsIndependent = Islndependent 
^ udtVF.MixedNumbers = MixedNumbers 

2^? Set Variable_Copy = udtV 

End Function 

r'j 
LI 
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* Variable. els 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = 0 Talse 

Persistable = 0 'NotPersistable 

DataBindingBehavior = 0 'vbNone 

DataSourceBehavior =0 VbNone 

MTSTransactionMode = 0 'NotAnMTSObject 
END 

Attribute VB_Name = "Variable" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VBPredeclaredId = False 
Attribute VB_Exposed = False 

Attribute VB_Ext_KEY - "SavedWithClassBuilder" ,"Yes" 
Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 
Option Explicit 

Private mstrName As String 
Private mudtType As VariableType 
Private mlnglndex As Long 
Private mblnEnabled As Boolean 
Private mblnlsDirty As Boolean 
Private mblnChecksum As Boolean 

Public Enum VariableType 

vtlnteger = 0 

vtReal - 1 

vtFraction = 2 

vtString = 3 

vtUntyped = 4 
End Enum 

Public Property Get name() As String 

name = mstrName 
End Property 

Public Property Let name(ByVal strNewValue As String) 

If mstrName o strNewValue Then 
mstrName = strNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Get Typ() As VariableType 

Typ = mudtType 
End Property 

Public Property Let Typ(ByVal udtNewValue As VariableType) 

If mudtType o udtNewValue Then 

mudtType = udtNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get indexQ As Long 

index = mlnglndex 
End Property 

Public Property Let index(ByVal IngNewValue As Long) 

If mlnglndex o IngNewValue Then 

mlnglndex = IngNewValue 

mblnlsDirty = True 
End If 

End Property 

Public Property Get EnabledQ As Boolean 

Enabled = mblnEnabled 
End Property 

Public Property Let Enabled(ByVal blnNewValue As Boolean) 

If mblnEnabled o blnNewValue Then 
mblnEnabled = blnNewValue 
mblnlsDirty = True 
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End If 
End Property 

Public Property Let IsDirty(ByVal blnNewValue As Boolean) 

mblnlsDirty = blnNewValue 
End Property 

Public Property Get IsDirtyQ As Boolean 

IsDirty = mblnlsDirty 
End Property 

Public Property Let Checksum(ByVal blnNewValue As Boolean) 

If mblnChecksum o blnNewValue Then 
^% mblnChecksum = blnNewValue 

1 mblnlsDirty = True 

H-i End If 



10 
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End Property 

Public Property Get ChecksumQ As Boolean 
20^3 Checksum = mblnChecksum 
End Property 

* implemented in the subclasses of Variable 
Public Function ProIogFormatQ As String 
End Function 

' implemented in the subclasses of Variable 
Public Function ScreenFormatQ As String 
30 End Function 

' implemented in the subclasses of Variable 



25 
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Public Sub ReadObjectData(udtFile As File) 
End Sub 

' implemented in the subclasses of Variable 
Public Sub WriteObjectData(udtFile As File) 
End Sub 

Public Property Get ReadType(udtFile As File) As VariableType 

Dim udtType As VariableType 

Call udtFile.ReadField(udtType) 

ReadType = udtType 
End Property 

' implemented in the subclasses of Variable 
PubHc Function CopyQ As Variable 
End Function 
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' Varlnteger.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
5 END 

Attribute VB_Name = " Varlnteger" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

' current version of data produced by this class 
1 5^., Const mintVERSIONSTAMP As Integer - 1 

Private mstrFrom As String 
m Private mstrTo As String 
4^ Private mstrBy As String 
J3 Private mblnlslndependent As Boolean 

20m Private Sub Class_Initialize() 

^ Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 
25 Set mudtVar = Nothing 

End Sub 



is? 

f 1 
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' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

Variable_Name = mudtVar.Name 

End Property 

* Delegated to Class Variable 
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Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name = RHS 
End Property 

* Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ = mudtVar.Typ 
End Property 

* Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar. Index 

End Property 

* Delegated to Class Variable 

Public Property Let Variable_Index(ByVal IngNewValue As Long) 

mudtVar. Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar.Enabled 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 
mudtVar.Enabled = RHS 
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End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(ByVal RHS As Boolean) 

mudtVar.IsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar. Checksum = blnNewValue 
End Property 

Public Property Get From() As String 

From = mstrFrom 
End Property 

Public Property Let From(ByVal strNewValue As String) 

If mstrFrom o strNewValue Then 

mstrFrom = strNewValue 

mudtVar.IsDirty = True 
End If 

End Property 
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Public Property Get TooQ As String 

Tog = mstrTo 
End Property 

Public Property Let Too(ByVal strNew Value As String) 

If mstrTo o strNewValue Then 

mstrTo = strNewValue 

mudtVar.IsDirty ~ True 
End If 

End Property 

Public Property Get By() As String 

By = mstrBy 
End Property 

Public Property Let By(ByVal strNewValue As String) 

If mstrBy o strNewValue Then 

mstrBy = strNewValue 

mudtVar JsDirty - True 
End If 

End Property 

Public Property Get IsIndependentQ As Boolean 

Islndependent = mblnlslndependent 
End Property 

Public Property Let IsIndependent(ByVal blnNewValue As Boolean) 

If mblnlslndependent o blnNewValue Then 

mblnlslndependent = blnNewValue 

mudtVar.IsDirty = True 
End If 

End Property 
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Public Sub Update(ByVal strName As String, _ 

ByVal strFrom As String, ByVal strTo As String, ByVal strBy As String, 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean) 

Variable_Name = strName 
From = StrFrom 
Too = strTo 
By = StrBy 

Islndependent = blnlslndependent 
Variable_Checksum = blnChecksum 

End Sub 

Public Function Variable_PrologFormat() As String 

Dim strl As String 

If mblnlslndependent Then 

strl - "int(" & mudtVar.Name & "),[" & mstrFrom & "<=" & _ 
mudtVar.Name & "<=" & mstrTo & " step " & mstrBy & 

Else 

strl = "int(" & mudtVar.Name & 
End If 

Variable_PrologFormat = strl 
End Function 

Public Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strT As String 
Dim strOpt As String 

If mudtVar. Checksum Then 

strOpt = "(C)" 
Else 

StrOpt = "(c)" 
End If 

If mblnlslndependent Then 

strl = mudtVar.Name & strOpt & ": Int, " & mstrFrom & " to " & _ 
mstrTo & " by " & mstrBy 

Else 

strl = mudtVar.Name & strOpt & ": Int" 
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End If 

Variable_ScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 

Variable_ReadType = mudtVar.ReadType(udtFile) 
End Property 

Public Sub Variable_ReadObjectData(udtFile As File) 
Dim vField As Variant 

Call udtFile.ReadField(vField) ' reads version stamp 

Call udtFile.ReadField(vField) 
mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar. Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar. Checksum = vField 

Call udtFile.ReadField(vField) 
From = vField 

Call udtFile.ReadField(vField) 
Too = vField 

Call udtFile.ReadField(vField) 
By = vField 

Call udtFile.ReadField(vField) 
Islndependent = vField 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 
Dim udtType As VariableType 
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udtType = vtlnteger 
Call udtFile.WriteField(udtType) 
Call udtFile.WriteField(mintVERSIONSTAMP) 
Call udtFile.WriteField(mudtVar.Name) 
5 Call udtFile.WriteField(mudtVar.Enabled) 

Call udtFile.WriteField(mudtVar.Checksum) 
Call udtFile.WriteField(From) 
Call udtFile.WriteField(Too) 
Call udtFile.WriteField(By) 
10 Call udtFile.WriteField(IsIndependent) 

mudtVar.IsDirty = False 

End Sub . 

' makes a copy of this object 
1 5 Public Function Variable_Copy() As Variable 

Dim udtVI As New Varlnteger 
% Dim udtV As Variable 

Ul Set udtV = udtVI 

J;i udtV.Name == mudtVar.Name 
4- udtV.Typ = vtlnteger 

udtV. Enabled = mudtVar.Index 

udtV.IsDirty = mudtVar.IsDirty 

ISzt udtV. Checksum = mudtVar.Checksum 

'•13 

'rl udtVI.From = From 

j=.r, udtVLToo = Too 

g udtVI.By = By 

30 udtVLIsIndependent = Islndependent 

Set Variable_Copy udtV 

End Function 
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' VarReal.cls 
VERSION 1.0 CLASS 
BEGIN 
Multiuser -1 True 
5 END 

Attribute VB_Name = "VarReal" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

' current version of data produced by this class 
1 4., Const mintVERSIONST AMP As Integer = 2 

, r ^': 

m Private mstrFrom As String 

Private mstrTo As String 

Private mstrBy As String 
4j Private mblnTrailingZeros As Boolean 
20|S Private mstrPrecision As String 
J3 Private mblnlslndependent As Boolean 
^ Private mblnlsOnGrid As Boolean 



2^: 



Private Sub Class_Initialize() 

Set mudtVar = New Variable 
End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 

30 End Sub 

' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

Variable Name = mudtVar.Name 
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End Property 

* Delegated to Class Variable 

Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name = RHS 
End Property 

* Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ = mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar.Enabled 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 

mudtVar.Enabled = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar.Index 

End Property 

* Delegated to Class Variable 
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Public Property Let Variable_Index(ByVal IngNewValue As Long) 

mudtVar.Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable JsDirty(ByVal RHS As Boolean) 

mudtVar.IsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNew Value As Boolean) 

mudtVar. Checksum = blnNewValue 
End Property 

Public Property Get From() As String 

From = mstrFrom 
End Property 

Public Property Let From(ByVal strNewValue As String) 

If mstrFrom o strNewValue Then 
mstrFrom = strNewValue 
mudtVar.IsDirty = True 
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End If 
End Property 

Public Property Get Too() As String 

Too = mstrTo 
End Property 

Public Property Let Too(ByVal strNewValue As String) 

If mstrTo o strNewValue Then 

mstrTo = strNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

Public Property Get By() As String 

By = mstrBy 
End Property 

Public Property Let By(ByVal strNewValue As String) 

If mstrBy <> strNewValue Then 

mstrBy = strNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

PubUc Property Get TrailingZerosQ As Boolean 

TrailingZeros = mblnTrailingZeros 
End Property 

Public Property Let TrailingZeros(ByVal blnNewValue As Boolean) 

If mblnTrailingZeros o blnNewValue Then 
mblnTrailingZeros = blnNewValue 
mudtVar.IsDirty = True 
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End If 
End Property 

Public Property Get IsOnGridQ As Boolean 

IsOnGrid = mblnlsOnGrid 

5 End Property 

Public Property Let IsOnGrid(ByVal blnNewValue As Boolean) 

If mblnlsOnGrid o blnNewValue Then 
mblnlsOnGrid = blnNewValue 
mudtVar.IsDirty = True 
10 End If 

End Property 

Public Property Get PrecisionQ As String 

Precision = mstrPrecision 
End Property 

Public Property Let Precision(ByVal strNewValue As String) 

If mstrPrecision o strNewValue Then 
mstrPrecision = strNewValue 
mudtVar.IsDirty = True 
End If 

20^' End Property 

Pubhc Property Get DecimalPlacesQ As Integer 

If InStr(l, mstrPrecision, ".") = 0 Then 

DecimalPlaces 0 
Else 

25 DecimalPlaces = Len(mstrPrecision) - 1 

End If 

End Property 

Public Property Get IsIndependentQ As Boolean 
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Islndependent = mblnlslndependent 
End Property 

Public Property Let IsIndependent(ByVal bbiNewValue As Boolean) 

If mblnlslndependent o blnNewValue Then 

mblnlslndependent = blnNewValue 

mudtVar.IsDirty = True 
End If 

End Property 

Public Sub Update(ByVal strName As String, _ 

ByVal strFrom As String, ByVal strTo As String, ByVal strBy As String, _ 
ByVal blnlslndependent As Boolean, ByVal blnChecksum As Boolean, _ 
ByVal blnTrailingZeros As Boolean, _ 

ByVal strPrecision As String, ByVal blnlsOnGrid As Boolean) 

Variable_Name = strName 
From = StrFrom 
Too = StrTo 
By = StrBy 

Islndependent = blnlslndependent 
Variable_Checksum = blnChecksum 
TrailingZeros = blnTrailingZeros 
Precision = strPrecision 
IsOnGrid = blnlsOnGrid 

End Sub 

Public Function Variable PrologFormatQ As String 

Dim strl As String 

If mblnlslndependent Then 

strl = "real({" & mudtVar.Name & & mstrPrecision & "}),[" _ 
& mstrFrom 8c "<=" & mudtVar.Name & "<=" & mstrTo & " step " & 
mstrBy&"]" 

Else 

strl = "real(" & mudtVar.Name & ")" 
End If 

If Not mbhilsOnGrid Then 

strl = strl & ",offgrid(" & mudtVar.Name & ")" 
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End If 



Variable_PrologFonnat = strl 
End Function 

Public Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strOpt As String 

If mud tVar. Checksum Then 

strOpt = "(C," 
Else 

StrOpt ="(c," 
End If 

If mblnTrailingZeros Then 

StrOpt = StrOpt & "T," 
Else 

StrOpt = StrOpt & "t," 
End If 

If mblnlsOnGrid Then 

StrOpt = StrOpt & "G," 
Else 

StrOpt = StrOpt & "g," 
End If 

StrOpt = StrOpt & mstrPrecision & ")" 

If mblnlslndependent Then 

strl = mudtVar.Name & strOpt & " 
mstrTo&" by"&mstrBy 

Else 

strl = mudtVar.Name & strOpt & " 
End If 

VariableScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 
Variable_ReadType = mudtVar.ReadType(udtFile) 
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: Real, " & mstrFrom & " to " & 
: Real" 



End Property 



Public Sub Variable_ReadObjectData(udtFile As File) 

Dim vField As Variant 
Dim intVersion As Integer 

Call udtFile.ReadField(vField) ' reads version stamp 
intVersion = vField 

Call udtFile.ReadField(vField) 
mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar. Checksum = vField 

Call udtFile.ReadField(vField) 
From = vField 

Call udtFile.ReadField(vField) 
Too - vField 

Call udtFile.ReadField(vField) 
By = vField 

Call udtFile.ReadField(vField) 
TrailingZeros = vField 

Call udtFile.ReadField(vField) 
Precision = vField 

Call udtFile.ReadField(vField) 
Islndependent = vField 

If intVersion < 2 Then ' this field is new to version 2 of VarReal 

IsOnGrid = True 
Else 

Call udtFile.ReadField(vField) 
IsOnGrid = vField 
End If 

End Sub 



VBSCA -446- 



Public Sub Variable_WriteObjectData(udtFile As File) 

Dim udtType As VariableType 

udtType = vtReal 

Call udtFile.WriteField(udtType) 

Call udtFile.WriteField(mintVERSIONSTAMP) 

Call udtFile.WriteField(mudtVar.Name) 

Call udtFile.WriteField(mudtVar.Enabled) 

Call udtFile.WriteField(mudtVar.Checksum) 

Call udtFile.WriteField(From) 

Call udtFile.WriteField(Too) 

Call udtFile.WriteField(By) 

Call udtFile.WriteField(TrailingZeros) 

Call udtFile.WriteField(Precision) 

Call udtFile.WriteField(IsIndependent) 

Call udtFile.WriteField(IsOnGrid) 

mudtVar.IsDirty = False 

End Sub 

' makes a copy of this object 

Public Function Variable_Copy() As Variable 

Dim udtVR As New VarReal 
Dim udtV As Variable 

Set udtV = udtVR 

udtV.Name = mudtVar.Name 
udtV.Typ = VtReal 
udtV.Enabled = mudtVar.Index 
udtV.IsDirty = mudtVar.IsDirty 
udtV.Checksum = mudtVar. Checksum 

udtVR.From = From 
udtVRToo = Too 
udtVR.By = By 
udtVR.Precision = Precision 
udtVR.TrailingZeros = TrailingZeros 
udtVR.IsIndependent = Islndependent 
udtVR.IsOnGrid = IsOnGrid 

Set Variable_Copy = udtV 
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End Function 



Ul 
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' VarStringxls 
VERSION 1.0 CLASS 
BEGIN 
Multiuser -1 True 
5 END 

Attribute VB_Name - "VarString" 
Attribute VB_GlobalNameSpace = False 
Attribute VBCreatable = True 
Attribute VBPredeclaredId = False 
1 0 Attribute VB_Exposed = False 
Option Explicit 

Implements Variable 

Private mudtVar As Variable 

' current version of data produced by this class 
1 5., Const mintVERSIONSTAMP As Integer = 1 

Private mstrDelimiter As String 

p Private mblnlslndexed As Boolean 

42 Private mcolString As New Collection 

Private Sub Class_Initialize() 

Set mudtVar = Nev^ Variable 

]Z End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 

End Sub 



25 



' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

30 Variable_Name = mudtVar.Name 

End Property 
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* Delegated to Class Variable 

Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Typ() As VariableType 

Variable_Typ = mudtVar.Typ 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 

* Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar.Index 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Index(ByVal IngNewValue As Long) 

mudtVar.Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar.Enabled 

End Property 

* Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 
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mudtVar.Enabled - RHS 
End Property 

* Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(ByVal RHS As Boolean) 

mudtVar.IsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 

Variable_Checksum = mudtVar. Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNewValue As Boolean) 

mudtVar. Checksum = blnNewValue 
End Property 

Public Property Get DelimiterQ As String 

Delimiter = mstrDelimiter 
End Property 

Public Property Let Delimiter(By Val strNewValue As String) 

If mstrDelimiter o strNewValue Then 

mstrDelimiter = strNewValue 

mudtVar.IsDirty = True 
End If 



VBSCA -451- 



End Property 

Public Property Get IsIndexedQ As Boolean 

Islndexed = mblnlslndexed 
End Property 

Public Property Let IsIndexed(ByVal blnNew Value As Boolean) 

mblnlslndexed = blnNew Value 
End Property 

Public Property Get StringCollectionQ As Collection 

Set StringCoUection = mcolString 
End Property 

Public Property Let StringCollection(ByVal colNewValue As Collection) 
Dim intlndex As Integer 

If mcolString.Count o colNewValue.Count Then 

Set mcolString = colNewValue 

mudtVar.IsDirty = True 

Exit Property 
End If 

For intlndex = 1 To mcolString.Count 

If mcolString.Item(intlndex) o colNewValue.Item(intlndex) Then 
Set mcolString = colNewValue 
mudtVar JsDirty = True 
Exit Property 
End If 
Next intlndex 

End Property 

' returns the largest number of delimited substrings in the string collection 
Public Property Get NumlndicesQ As Integer 

Dim intD As Integer 
Dim intHiD As Integer 
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Dim inti As Integer 

Dim varS As Variant 

Dim udtSubStr As New Substring 

' if there are no strings in the collection 
If mcolString. Count ^ 0 Then 

Numlndices = 1 

Exit Property 
End If 

udtSubStr.Delimiter = mstrDelimiter 

For Each varS In mcolString 

udtSubStr.StringValue = varS 

into = udtSubStr.NumSubStrings 

IfintD>intHiD Then 
intHiD = intD 

End If 
Next varS 

Numlndices = intHiD 
End Property 

Public Function Variable_PrologFormat() As String 

Variable_PrologFonnat = 
End Function 

Public Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strS As String 
Dim intlndex As Integer 
Dim strOpt As String 

If mudtVar. Checksum Then 

strOpt = "(C," 
Else 

StrOpt = "(c," 
End If 

StrOpt = StrOpt & Str(NumIndices) & & mstrDelimiter & ")" 
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For intlndex = 1 To 3 



If mcolString. Count >= intlndex Then 

strS = strS & mcolString. Item(intlndex) 

If mcolString.Count > intlndex Then 
StrS - StrS & 

End If 
End If 

Next intlndex 

If mcolString. Count > 3 Then 

StrS = StrS &"..." 
End If 

strl = mudtVar.Name & strOpt & ": String, in [" & strS & 
Variable_ScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 

Variable_ReadType = mudtVar.ReadType(udtFile) 
End Property 

PubHc Sub Variable_ReadObjectData(udtFile As File) 

Dim vField As Variant 
Dim intCount As Integer 

Call udtFile.ReadField(vField) * reads version stamp 
Call udtFile.ReadField(vField) 
mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

Call udtFile.ReadField(vField) 
mudtVar. Checksum = vField 

Call udtFile.ReadField(vField) 
mstrDelimiter = vField 
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Call udtFile.ReadField(vField) 
mblnlslndexed = vField 

Call udtFile.ReadField(vField) 
intCount = vField 

Dim inti As Integer 

* read in the strings 
For intI ^ 1 To intCount 

Call udtFile.ReadField(vField) 
Call mcolString.Add(vField) 

Next intI 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 

Dim udtType As VariableType 

udtType = vtString 

Call udtFile.WriteField(udtType) 

Call udtFile,WriteField(mintVERSIONSTAMP) 

Call udtFile, WriteField(mudtVar.Name) 

Call udtFile.WriteField(mudtVar.Enabled) 

Call udtFile.WriteField(mudtVar.Checksum) 

C all udtFi le . Wri teField(ms trD elimiter) 

Call udtFile. WriteField(mblnlsIndexed) 

Dim intCount As Integer 

intCount = mcolString. Count 
Call udtFile. WriteField(intCount) 

Dim intI As Integer 

' write out the strings 

For intI = 1 To mcolString. Count 

Call udtFile.WriteField(mcolString.Item(intI)) 
Next intI 

mudtVar.IsDirty - False 
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End Sub 



' makes a copy of this object 

Public Function Variable_Copy() As Variable 

Dim udtVS As New VarString 
Dim udtV As Variable 
Dim varS As Variant 

Set udtV = udtVS 

udtV.Name = mudtVar.Name 
udtV.Typ = vtString 
udtV. Enabled = mudtVar. Index 
udtV.IsDirty = mudtVar.IsDirty 
udtV.Checksum = mudtVar. Checksum 

udtVS.DeUmiter = Delimiter 
udtVS.IsIndexed = Islndexed 

Set Variable_Copy = udtV 

For Each varS In mcolString 

Call udtVS.StringCollection.Add(varS) 
Next varS 

End Function 



' VarUntyped.cls 
VERSION 1.0 CLASS 
BEGIN 

MultiUse = -l True 
END 

Attribute VB_Name = "VarUntyped" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed - False 
Option Explicit 



Implements Variable 



Private mudtVar As Variable 

' current version of data produced by this class 
Const mintVERSIONSTAMP As Integer = 1 

Private Sub Class_Initialize() 

Set mudtVar = New Variable 

End Sub 

Private Sub Class_Terminate() 

Set mudtVar = Nothing 
End Sub 

' Delegated to Class Variable 

Public Property Get Variable_Name() As String 

Variable_Name = mudtVar.Name 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Name(ByVal RHS As String) 

mudtVar.Name = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable TypQ As VariableType 

Variable_Typ = mudtVar. Typ 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Typ(ByVal udtNewValue As VariableType) 

mudtVar.Typ = udtNewValue 
End Property 
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' Delegated to Class Variable 

Public Property Get Variable_Index() As Long 

Variable_Index = mudtVar .Index 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Index(ByVal IngNewValue As Long) 

mudtVar.Index = IngNewValue 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Enabled() As Boolean 

Variable_Enabled = mudtVar.Enabled 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_Enabled(ByVal RHS As Boolean) 

mudtVar.Enabled = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_IsDirty() As Boolean 

Variable_IsDirty = mudtVar.IsDirty 

End Property 

' Delegated to Class Variable 

Public Property Let Variable_IsDirty(By Val RHS As Boolean) 

mudtVar.IsDirty = RHS 
End Property 

' Delegated to Class Variable 

Public Property Get Variable_Checksum() As Boolean 
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Variable_Checksum = mudtVar.Checksum 
End Property 

' Delegated to Class Variable 

Public Property Let Variable_Checksum(ByVal blnNew Value As Boolean) 

mudtVar.Checksum = blnNew Value 
End Property 

Public Function Variable_PrologFormat() As String 

Variable_PrologFormat = 
End Function 

Public Function Variable_ScreenFormat() As String 

Dim strl As String 
Dim strS As String 
Dim intlndex As Integer 
Dim strOpt As String 

If mudtVar.Checksum Then 

strOpt = "(C)" 
Else 

StrOpt = "(c)" 
End If 

strl =mudtVar.Name & strOpt & ": Untyped" 
Variable_ScreenFormat = strl 
End Function 

Public Property Get Variable_ReadType(udtFile As File) As VariableType 

Variable_ReadType = mudtVar.ReadType(udtFile) 
End Property 

Public Sub Variable_ReadObjectData(udtFile As File) 
Dim vField As Variant 
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Dim intCount As Integer 

Call udtFile.ReadField(vField) ' reads version stamp 
Call udtFile.ReadField(vField) 
5 mudtVar.Name = vField 

Call udtFile.ReadField(vField) 
mudtVar.Enabled = vField 

10 Call udtFile.ReadField(vField) 

mudtVar. Checksum = vField 

End Sub 

Public Sub Variable_WriteObjectData(udtFile As File) 

15 Dim udtType As VariableType 

.==; udtType = vtUntyped 

^ Call udtFile.WriteField(udtType) 

|! Call udtFile.WriteField(mintVERSIONSTAMP) 

20ji CalludtFile.WriteField(mudtVar.Name) 

4;i Call udtFile.WriteField(mudtVar.Enabled) 

4] Call udtFile.WriteField(mudtVar.Checksum) 

3 " 

sin 

mudtVar JsDirty = False 
2^ End Sub 



' makes a copy of this object 
^« Public Function Variable_Copy() As Variable 



35 



Dim udtV As New Variable 



30 udtV.Name = mudtVar.Name 

udtV.Typ = VtUntyped 
udtV. Enabled = mudtVar.Index 
udtV.IsDirty = mudtVar.IsDirty 
udtV. Checksum = mudtVar.Checksum 



Set Variable_Copy = udtV 
End Function 
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' Win32API.cls 
VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
END 

Attribute VB_Name = "Win32APr' 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
' used for making calls to the Win32 API 
Option Explicit 

Private Type FILETIME 

dwLowDateTime As Long 

dwHighDateTime As Long 
End Type 

Private Const MAX_PATH = 260 

Private Type WIN32_FIND_DATA 

dwFileAttributes As Long 

ftCreationTime As FILETIME 

ftLastAccessTime As FILETIME 

ftLastWriteTime As FILETIME 

nFileSizeHigh As Long 

nFileSizeLow As Long 

dwReservedO As Long 

dwReservedl As Long 

cFileName As String * MAX_PATH 

cAltemate As String * 14 
End Type 

Private Const INVALID_HANDLE_VALUE = -1 

Private Declare Function FindFirstFile Lib "kemel32" Alias "FindFirstFileA" _ 
(ByVal IpFileName As String, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindNextFile Lib "kemel32" Alias "FindNextFileA" _ 
(ByVal hFileName As Long, IpFindFileData As WIN32_FIND_DATA) As Long 

Private Declare Function FindClose Lib "kemel32" (ByVal hFindFile As Long) As Long 

Private Declare Function GetCurrentDirectory Lib "kemel32" _ 
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Alias "GetCurrentDirectoryA" (ByVal nBufferLength As Long, _ 
ByVal IpBuffer As String) As Long 

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _ 
(ByVal hwnd As Long, _ 
ByVal Msg As Long, _ 
ByVal wParam As Long, _ 
ByVal IParam As Long) As Long 

Private Declare Function SystemParametersInfo Lib "user32" _ 
Alias "SystemParametersInfo A" (ByVal u Action As Long, _ 
ByVal uParam As Long, ByRef IpvParam As Any, _ 
ByVal fuWinIni As Long) As Long 

Private Const SPI_GETDRAGFULLWINDOWS = 38 
Private Const SPI_SETDRAGFULLWINDOWS = 37 
Private Const SPIF_SENDWININICHANGE = 2 

Public Function IsFullWindowDragOn() As Boolean 

Dim result As Long 

'Call API and check for successful call. 

If SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0&, result, 0&) o 0 Then 
Teature supported now check value of result. 
If resuh = 0 Then 

IsFullWindowDragOn = False 
Else 

IsFullWindowDragOn = True 
End If 

'Call failed, feature not supported. 
Else 

IsFullWindowDragOn = False 
End If 

End Function 

Public Sub TumOffFullWindowDragO 
Dim result As Long 

result = SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0&, _ 
ByVal vbNullString, SPIF_SENDWININICHANGE) 

End Sub 
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Public Sub TumOnFullWindowDragO 
Dim result As Long 

result = SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1&, 
ByVal vbNuUString, SPIF_SENDWININICHANGE) 

End Sub 

' returns true if strFN exists 

Public Function FileExists(ByVal strFN) As Boolean 

Dim IngHandle As Long 

Dim w32FindData As WIN32_FIND_DATA 

IngHandle = FindFirstFile(strFN, w32FindData) 

If IngHandle = INVALID_HANDLE_VALUE Then 

FileExists = False 
Else 

FileExists = True 
Call FindClose(lngHandle) 
End If 

End Function 

' returns a collection of file names that satisfy strMask. The path seems to 
' disappear from the returned file names. 

Public Function FindAllFiles(ByVal strMask As String) As Collection 

Dim IngHandle As Long 
Dim IngRet As Long 

Dim w32FindData As WIN32_FIND_DATA 

Dim StrFN As String 

Dim varl As Variant 

Dim colFNs As New Collection 

IngHandle = FindFirstFile(strMask, w32FindData) 

If IngHandle = INVALID_HANDLE_VALUE Then 

Exit Function 
End If 

Do 
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strFN = TrimAtFirstNull(w32FindData.cFileName) 
Call colFNs.Add(strFN) ' add to the collection 

Loop Until FindNextFile(lngHandle, w32FindData) = 0 

Set FindAllFiles = colFNs 

End Function 

' returns the current directory 

Public Function CurrentDirectory() As String 

Dim strBuf As String 
Dim IngRet As Long 
Dim varl As Variant 

StrBuf = Space(300) 

IngRet = GetCurrentDirectory(300, strBuf) 
CurrentDirectory = TrimAtFirstNull(strBuf) 

End Function 

' enable full row select in list view control 

Public Sub EnableListViewFullRowSelect(lvwLV As ListView) 

Dim IngStyle As Long 
Dim IngL As Long 

'get the current ListView style 

IngStyle = SendMessageLong(lvwLV.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 
0&) 

'set the extended style bit 

IngStyle = IngStyle Or LVS_EX_FULLROWSELECT 
'set the new ListView style 

IngL = SendMessageLong(lvwLV.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, 
IngStyle) 

End Sub 
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' Word.cls 

VERSION 1.0 CLASS 
BEGIN 
MultiUse = -l True 
5 END 

Attribute VB_Name = "MSWord" 
Attribute VB_GlobaINameSpace = False 
Attribute VB_Creatable = True 
Attribute VBPredeclaredId = False 
1 0 Attribute VBExposed = False 
Option Explicit 

Private Const WM_CLOSE = &H10 
Private mWDApp As Word.Application 

Private Type RECT 
15 left As Long 

top As Long 
jl right As Long 
m bottom As Long 
yi End Type 

im Private Declare Function GetParent Lib "user32" _ 
4~ (ByVal hWndChild As Long) As Long 

^ Private Declare Function SetParent Lib "user32" _ 

m (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long 

Tl Private Declare Function FindWindow Lib "user32" _ 
2Sj Alias "FindWindowA" (ByVal IpClassName As String, _ 
2r^ ByVal IpWindowName As String) As Long 

Private Declare Function SendMessage Lib "user32" _ 
Alias "SendMessageA" _ 

(ByVal hwnd As Long, ByVal wMsg As Long, _ 
30 ByVal wParam As Long, IParam As Any) As Long 

Private Declare Function GetWindowRect Lib "user32" _ 
(ByVal hwnd As Long, IpRect As RECT) As Long 

Private Declare Function SetWindowPos Lib "user32" _ 
(ByVal hwnd As Long, ByVal hWndlnsertAfter As Long, _ 
35 ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _ 

ByVal cy As Long, ByVal wFlags As Long) As Long 
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Dim mlngHandle As Long 
Dim origParent As Long 
Dim origLefl As Long 
Dim origTop As Long 
Dim origWidth As Long 
Dim origHeight As Long 

Private Sub Class_Initialize() 

' mlngHandle - FindWindow("OpusApp", vbNullString) 

' Do While mlngHandle o 0 

SendMessage mlngHandle, WM_CLOSE, mlngHandle, 0 
mlngHandle = Find Window(" Opus App", vbNuUString) 

' Loop 

mlngHandle - FindWindow("OpusApp", vbNullString) 

If mlngHandle o 0 Then 

Set mWDApp = GetObject(, "Word. Application. 8") 
Else 

On Error Resume Next 

Set mWDApp = GetObject(, "Word.Application.8") 

If err.Number = 0 Then 

MsgBox "Phantom WinWord detected!" 

Call mWDApp.Quit(False) 
Else 

err.Clear 
End If 

Set mWDApp - CreateObject(" Word. Application. 8") 
End If 

mlngHandle = FindWindov^("OpusApp", vbNullString) 

If mlngHandle o 0 Then 

origParent = GetParent(mlngHandle) 

If mWDApp.left < 0 Then 

origLeft = 0 
Else 

origLeft = mWDApp.left 
End If 
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If mWDApp.top < 0 Then 

origTop = 0 
Else 

origTop = mWDApp.top 
5 End If 

origWidth = mWDApp.Width 
origHeight = mWDApp.Height 

Call SetParent(mlngHandle, frmTCA.fraWord.hwnd) 
End If 

1 0 mWDApp. Visible = True 

End Sub 

Private Sub Class TerminateQ 

=^ mWDApp.Visible = False 

Call SetParent(mlngHandle, origParent) 
I^^ Call mWDApp.Move(origLeft, origTop) 
'j^ Call mWDApp.Resize(origWidth, origHeight) 

$ Call mWDApp,Quit(False) ' don't save! 

End Sub 

Public Property Get WordAppQ As Word.Application 
2(|- Set WordApp = mWDApp 

End Property 

Public Property Get DocumentsCount() As Long 

DocumentsCount = mWDApp.Documents.Count 
End Property 

25 Public Property Get SelectionTypeQ As Long 
SelectionType = mWDApp.Selection.Type 
End Property 
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Public Property Get SelectionTextQ As String 

SelectionText = mWDApp.Selection.Text 

End Property 

Public Sub ResizeQ 

5 Dim WindowRect As RECT 

GetWindowRect frmTCA.fraWord.hwnd, WindowRect 

Dim IngH As Long 
Dim IngW As Long 

IngW = frmTCA.ScaleX(WindowRect.right - WindowRect. left, vbPixels, vbPoints) 
1 0 IngH = frmTCA.ScaleY(WindowRect.bottom - WindowRect.top, vbPixels, vbPoints) 

^, Call mWDApp.Resize(lngW, IngH) 
J{ Call mWDApp.Move(0, 0) 

J * SetWindowPos mlngHandle, 0, 0, 0, _ 
4= ' WindowRect.right - WindowRect. left, _ 
1 ' WindowRect.bottom - WindowRect.top, 64 

J3 CommandBars("File").Controls("Exit").Enabled = False 

End Sub 

^ Public Sub CloseAUDocsO 

i'i Dim docD As Document 

20 For Each docD In mWDApp.Documents 

If Not docD. Readonly Then 

docD.Close 
Else 

Call docD.Close(False) 
25 End If 

Next docD 

End Sub 
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